home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / 173abas.zip / RBBSSUB5.BAS < prev   
BASIC Source File  |  1990-08-26  |  92KB  |  2,696 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB5.BAS 17.3A, Copyright 1986 - 90 by D. Thomas Mack' ' DA081003
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB5.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.: August 26, 1990
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  BinSearch      63520  Binary searches sorted file for a key value
  18. '  BreakFileName  63300  Break file name into component parts
  19. '  BufAsUnit      63500  Buffer out a string with CR's
  20. '  SetPrompt      63470  Set prompts based on the user's security
  21. '  DoorReturn     63100  Process door requests
  22. '  FdMacExe       63462  Executes a found macro
  23. '  FileSystem     20117  File System for RBBS-PC
  24. '  FindIt         63490  Check whether file exists and if so open as #2
  25. '  FormRead       63420  Read from file into a form
  26. '  LockAppend     63400  Prepare for a file append
  27. '  MacroExe       63460  Execute internal macro rather than user
  28. '  MsgNameMatch   63540  Match name to one in msg header
  29. '  NoPath         63480  Detects whether string has a path in it
  30. '  RestoreCom     63310  Restore comm port after external program
  31. '  ReadMacro      63330  Read and process macro
  32. '  ShellExit      63320  Exit RBBS via shell
  33. '  TakeOffHook    63530  Take modem off hook
  34. '  UnLockAppend   63410  Clean up after file append
  35. '  VerifyAns      63510  Verify that string passes edits
  36. '  WildCard       63200  Match string to a pattern
  37. '
  38. '  $INCLUDE: 'RBBS-VAR.BAS'
  39. '
  40. 20117 ' $SUBTITLE: 'FileSystem -- subroutine for RBBS-PC's file system'
  41. ' $PAGE
  42. '
  43. ' NAME    -- FileSystem
  44. '
  45. ' INPUTS  --       PARAMETER                 MEANING
  46. '             ZFileSysParm = 1  LIST THE SYSOP'S COMMENTS FILE
  47. '                                 2  L)IST DIRECTORY COMMAND
  48. '                                 3  D)OWNLOAD COMMAND
  49. '                                 4  RETURN FROM EXTERNAL PROTOCOLS
  50. '                                 5  U)PLOAD COMMAND
  51. '                                 6  S)CAN DIRECTORY COMMAND
  52. '                                 7  P)ERSONAL FILES COMMAND
  53. '                                 8  N)EW FILES COMMAND
  54. '                                 9  RETURN FROM EXTENDED DESCRIPTION
  55. '
  56. ' OUTPUTS -- ZFileSysParm = 1  COMMAND PROCESSED SUCCESSFULLY
  57. '                                2  RECYCLE TO TOP OF RBBS-PC (202)
  58. '                                3  PROCESS NEXT COMMAND (1200)
  59. '                                4  DENY USER ACCESS (1380)
  60. '                                5  HANDLE EXTENDED DESCRIP. (2008)
  61. '                                6  USER'S TIME EXCEEDED (10553)
  62. '                                7  Carrier DROPPED (10595)
  63. '
  64. ' PURPOSE -- To handle the RBBS-PC file system commands
  65. '
  66.       SUB FileSystem STATIC
  67.       ZFF = ZFileSysParm
  68.       ZFileSysParm = 1
  69.       ON ZFF GOSUB 20119, _  ' HANDLER TO LIST COMMENTS TO SYSOP
  70.                   20150, _  ' L)IST DIRECTORY COMMAND HANDLER
  71.                   20180, _  ' D)OWNLOAD COMMAND HANDLER
  72.                   20263, _  ' RETURN FROM EXTERNAL Protocol'S
  73.                   20400, _  ' U)PLOAD COMMAND HANDLER
  74.                   21800, _  ' S)CAN DIRECTORY COMMAND HANDLER
  75.                   21850, _  ' P)ERSONAL FILES COMMAND HANDLER
  76.                   21860, _  ' N)EW FILES COMMAND HANDLER
  77.                   20705     ' RETURN FROM EXTENDED DESCRIPTIONS
  78.       GOTO 21920
  79. 20119 ZErrCode = 0
  80.       GOTO 20122
  81. '
  82. ' *****  SCAN DIRECTORIES (PRINT TEXT)  ****
  83. '
  84. '  (formerly lines 7000 to 7260 in RBBS-PC.BAS CPC16-1A
  85. 20120 ZOutTxt$ = "Scanning Directory " + _
  86.            ZFileNameHold$
  87.       IF WasRS$ <> "" THEN _
  88.          ZOutTxt$ = ZOutTxt$ + " for " + WasRS$
  89.       GOSUB 21650
  90.       IF ZFileSysParm > 1 THEN _
  91.          RETURN
  92.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)                 ' KG040901
  93.       IF ZNo THEN _                                                  ' KG040901
  94.          ZErrCode = 0 : _                                            ' KG040901
  95.          RETURN                                                      ' KG040901
  96.       WasPG = ZTrue
  97. 20122 CALL OpenWork (2,ZFileName$)
  98.       IF ZErrCode = 53 THEN _
  99.          ZOutTxt$ = "Missing File " + ZFileName$ : _
  100.          CALL UpdtCalr (ZOutTxt$,2) : _
  101.          ZOutTxt$ = ZOutTxt$ + _
  102.               ". Please tell SYSOP" : _
  103.          GOSUB 21650 : _
  104.          RETURN
  105.       ZJumpSupported = ZTrue
  106.       ZJumpLast$ = ""
  107.       LastOK = ZFalse
  108.       ZJumpSearching = ZFalse                                        ' ML071502
  109. 20124 CALL Carrier
  110.       IF EOF(2) OR _
  111.          (ZSubParm = -1 AND NOT ZLocalUser) THEN _
  112.          GOTO 20142
  113. 20126 CALL ReadDir (2,1)
  114.       IF ZErrCode <> 0 THEN _
  115.          ZWasEL = 20126 : _
  116.          GOTO 21900
  117.       IF WasCK = 0 THEN _
  118.          GOTO 20140
  119.       IF LEFT$(ZOutTxt$,1) = " " THEN _
  120.          IF LastOK AND NOT ZExtendedOff THEN _
  121.             GOTO 20140 _
  122.          ELSE GOTO 20124
  123.       LastOK = ZFalse
  124. 20128 IF ZJumpSearching THEN _
  125.          GOTO 20129
  126.       IF WasCK < 2 THEN _
  127.          GOTO 20130
  128.       IF WildSearch THEN _
  129.          ZWasA = INSTR(ZOutTxt$," ") : _
  130.          IF ZWasA = 0 THEN _
  131.             GOTO 20124 _
  132.          ELSE ZWasZ$ = LEFT$(ZOutTxt$,ZWasA - 1) : _
  133.               CALL WildFile (WasRS$,ZWasZ$,WasXXX) : _
  134.               WasXXX = NOT WasXXX : _
  135.               GOTO 20136
  136. 20129 ZWasZ$ = ZOutTxt$
  137.       CALL AllCaps (ZWasZ$)
  138.       WasXXX = (INSTR(ZWasZ$,WasRS$) = 0)
  139.       GOTO 20136
  140. 20130 ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"/")
  141.       IF ZWasA = 0 THEN _
  142.          ZWasA = INSTR(9,MID$(ZOutTxt$,1,32),"-")
  143. 20132 IF ZWasA < 3 THEN _
  144.          GOTO 20124
  145.       IF INSTR("0123456789",MID$(ZOutTxt$,ZWasA - 1,1)) = 0 THEN _
  146.          GOTO 20124
  147.       ZWasA = ZWasA - 2
  148.       WasWK$ = RIGHT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  149.             LEFT$(MID$(ZOutTxt$,ZWasA,8),2) + _
  150.             MID$(MID$(ZOutTxt$,ZWasA,8),4,2)
  151.       IF MID$(WasWK$,3,1) = " " THEN _
  152.          MID$(WasWK$,3,1) = "0"
  153.       IF MID$(WasWK$,5,1) = " " THEN _
  154.          MID$(WasWK$,5,1) = "0"
  155. 20134 WasXXX = (WasWK$ < WasRS$)
  156. 20136 IF WasXXX THEN _
  157.          GOTO 20124
  158.       IF ZJumpSearching THEN _
  159.          WasRS$ = PrevSearch$ : _
  160.          WasCK = PrevCK : _
  161.          ZJumpSearching = ZFalse : _
  162.          GOTO 20140
  163.       IF WasPG THEN _
  164.          WasPG = ZFalse : _
  165.          CALL OpenWork (2,ZFileName$) : _
  166.          ZWasQ = 0 : _
  167.          GOTO 20124
  168. 20138 IF WasPG THEN _
  169.          GOTO 20124
  170. 20140 LastOK = ZTrue
  171.       GOSUB 21650
  172.       IF ZFileSysParm > 1 THEN _
  173.          RETURN
  174.       CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  175.       IF ZNo THEN _
  176.          ZErrCode = 0 : _
  177.          RETURN
  178.       IF ZJumpSearching THEN _
  179.          IF LEFT$(ZOutTxt$,1) <> " " THEN _
  180.             PrevSearch$ = WasRS$ : _
  181.             PrevCK = WasCK : _
  182.             WasCK = 2 : _
  183.             WasRS$ = ZJumpTo$
  184.       IF NOT ZRet THEN _
  185.          GOTO 20124
  186. 20142 ZWasQ = 0
  187.       ZJumpSupported = ZFalse
  188.       CLOSE 2
  189.       CALL Carrier
  190.       IF ZSubParm = -1 THEN _
  191.          ZFileSysParm = 7
  192.       RETURN
  193. '
  194. ' *  L - COMMAND FROM FILES MENU (LIST DIRECTORY)
  195. '
  196. 20150 ZListDir = ZTrue
  197.       ListNew = ZFalse
  198.       SearchDate$ = ""
  199.       SearchString$ = ""
  200.       WasRS$ = ""
  201.       ShowDirOfDir = (ZLastIndex <= ZAnsIndex) AND NOT ZExpertUser
  202.       WasCK = 0
  203.       ZSearchingAll = ZFalse
  204. 20155 IF ListNew OR ZAnsIndex > 255 THEN _
  205.          RETURN
  206.       CALL GetDirs (ShowDirOfDir)
  207.       IF ZWasQ = 0 THEN _
  208.          RETURN
  209.       ShowDirOfDir = ZFalse
  210.       CALL ConvertDir (ZAnsIndex)
  211.       WasQX = ZLastIndex
  212. 20157 CALL Carrier
  213.       IF ZSubParm = -1 THEN _
  214.          ZFileSysParm = 7 : _
  215.          RETURN
  216.       GOTO 20161
  217. 20159 IF ZAnsIndex < ZLastIndex THEN _
  218.          GOTO 20155
  219.       ZSearchingAll = ZFalse
  220.       CALL CmdStackPushPop (1)
  221.       ZLastIndex = 0
  222.       IF ZNo OR (ZFileNameHold$ = ZDirPrefix$) THEN _
  223.          GOTO 20155
  224.       CALL QuickTPut (ZEmphasizeOff$,0)
  225.       ZOutTxt$ = "End list.  R)elist, [Q]uit, or file(s) to dwnld"   ' KG082004
  226.       ZStackC = ZTrue
  227.       GOSUB 21668
  228.       CALL AllCaps (ZUserIn$(1))
  229.       IF ZUserIn$(1) = "R" THEN _
  230.          ZUserIn$(ZAnsIndex) = WasA1$ : _
  231.          GOTO 20161
  232.       IF LEN(ZUserIn$(1)) > 1 AND _
  233.          ZUserSecLevel >= ZOptSec(19 - 20 * (ZMenuIndex = 6)) THEN _
  234.          ZAnsIndex = 1 : _
  235.          GOSUB 20202
  236.       CALL CmdStackPushPop (2)
  237.       RETURN
  238. 20161 IF INSTR(ZUserIn$(ZAnsIndex),".") THEN _
  239.          GOTO 20172
  240.       ZViolation$ = "List Dir. "
  241.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  242.       ZWasA = INSTR("E+E-E",ZWasZ$)
  243.       IF ZWasA > 0 THEN _
  244.          IF ZWasA = 5 THEN _
  245.             ZExtendedOff = NOT ZExtendedOff : _
  246.             GOTO 20155 _
  247.          ELSE ZExtendedOff = (ZWasA > 2) : _
  248.               GOTO 20155
  249.       CALL AllCaps(ZWasZ$)
  250.       ZFileNameHold$ = ZWasZ$
  251.       WasA1$ = ZWasZ$
  252.       IF ZWasZ$ = ZDirPrefix$ THEN _
  253.          GOTO 20164
  254.       InFMS = ZFalse
  255. 20162 CALL CmdStackPushPop (1)         ' save dir list list processing
  256.       CALL FMS (ZWasZ$,SearchString$,SearchDate$,InFMS, _
  257.                 ZCategoryName$(),ZCategoryCode$(),ZCategoryDesc$(),_
  258.                 DnldFlag,CatFound,ZAnsIndex)
  259.       WHILE DnldFlag > 0 AND ZSubParm > -1
  260.          GOSUB 20202
  261.          IF ZFileSysParm > 1 THEN _
  262.             RETURN
  263.          WasX$ = ZCategoryCode$(CatFound)
  264.          CALL DispUpDir (WasX$,SearchString$,SearchDate$,DnldFlag,ZAnsIndex)
  265.          CALL CheckTimeRemain (MinsRemaining)
  266.          IF ZSubParm = -1 THEN _
  267.             ZFileSysParm = 6 : _
  268.             RETURN
  269.          CALL Carrier
  270.       WEND
  271.       IF ZSubParm = -1 THEN _
  272.          ZFileSysParm = 7 : _
  273.          RETURN
  274.       IF ZAnsIndex > 255 THEN _
  275.          ZLastIndex = 0 : _
  276.          RETURN
  277.       CALL CmdStackPushPop (2)        ' restore dir list list processing
  278.       ZActiveFMSDir$ = ""
  279.       IF InFMS THEN _
  280.          GOTO 20159
  281.       IF ZUserSecLevel < ZMinSecToView THEN _
  282.          IF ZFileNameHold$ = ZUpldDirCheck$ THEN _
  283.             ZFileNameHold$ = "of uploads" : _
  284.             GOTO 20172
  285.       ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  286.       IF ZLimitSearchToFMS THEN _
  287.          GOTO 20166
  288.       IF NOT ZSearchingAll THEN _
  289.          IF ZFileNameHold$ = "ALL" OR ZFileNameHold$ = "A" THEN _
  290.             ZSearchingAll = ZTrue : _
  291.             GOSUB 21890 : _
  292.             GOTO 20157
  293.       CALL BadFile (ZFileNameHold$,BadFileNameIndex)
  294.       ON BadFileNameIndex GOTO 20163,20172,20176
  295. 20163 ZFileName$ = ZFileNameHold$
  296.       CALL BadName (BadFileNameIndex)
  297.       ON BadFileNameIndex GOTO 20164,20176
  298. 20164 IF ZFileName$ = ZUpldDirCheck$ AND _
  299.          ZUserSecLevel >= ZMinSecToView THEN _
  300.             ZFileName$ = ZUpldPath$ _
  301.       ELSE ZFileName$ = ZCurDirPath$
  302.       ZFileName$ = ZFileName$ + _
  303.                    ZFileNameHold$ + _
  304.                    "." + _
  305.                    ZDirExtension$
  306.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  307. 20165 IF ZOK THEN _
  308.          CALL ReadDir (2,1) : _
  309.          IF ZErrCode = 0 THEN _
  310.             IF LEFT$(ZOutTxt$,4) = "\FMS" THEN _
  311.                InFMS = ZTrue : _
  312.                ZActiveFMSDir$ = ZFileName$ : _
  313.                GOTO 20162 _
  314.             ELSE GOTO 20167
  315. 20166 ZFileName$ = ZCurDirPath$ + _
  316.                    ZFileNameHold$ + ".MNU"
  317.       CALL FindIt (ZFileName$)
  318.       IF ZOK THEN _
  319.          CALL BufFile (ZFileName$,ZAnsIndex) : _
  320.          GOTO 20155
  321.       IF ZAltdirExtension$ = "" THEN _
  322.          GOTO 20172
  323.       ZFileName$ = ZCurDirPath$ + _
  324.                    ZFileNameHold$ + _
  325.                    "." + _
  326.                    ZAltdirExtension$
  327.       CALL Graphic (ZUserGraphicDefault$,ZFileName$)
  328.       IF NOT ZOK THEN _
  329.          GOTO 20172
  330. 20167 ZUserIn$(0) = ZUserIn$(ZAnsIndex)
  331.       GOSUB 20120
  332.       IF ZFileSysParm > 1 THEN _
  333.          RETURN
  334.       GOTO 20170
  335. 20168 CALL BufFile(ZFileName$,ZAnsIndex)
  336.       CALL Carrier
  337.       IF ZSubParm = -1 THEN _
  338.          ZFileSysParm = 7 : _
  339.          RETURN
  340. 20170 IF ZAnsIndex > 255 THEN _
  341.          ZLastIndex = 0 : _
  342.          RETURN
  343.       ZUserIn$(ZAnsIndex) = ZUserIn$(0)
  344.       GOTO 20159
  345. 20172 IF NOT ZSearchingAll THEN _
  346.          ZOutTxt$ = "Directory " + _
  347.               ZFileNameHold$ + _
  348.               " not found!" : _
  349.          GOSUB 21640 : _
  350.          ZNo = ZTrue : _
  351.          IF ZFileSysParm > 1 THEN _
  352.             RETURN
  353.       GOTO 20155
  354. 20176 CALL SecViolation
  355.       IF ZDenyAccess THEN _
  356.          ZFileSysParm = 4 : _
  357.          RETURN
  358.       GOTO 20172
  359. '
  360. ' *  D - COMMAND FROM FILES MENU (SEARCH FOR FILE TO DOWNLOAD)
  361. '
  362. 20180 ZOutTxt$ = "Download what file(s)"
  363.       ZStackC = ZTrue
  364.       GOSUB 21668
  365.       IF ZFileSysParm > 1 THEN _
  366.          RETURN
  367.       IF ZWasQ = 0 THEN _
  368.          RETURN
  369. 20202 IF (ZTimeLock AND 2) AND (NOT TimeLockExempt) AND NOT ZHasPrivDoor THEN _
  370.          CALL TimeLock : _
  371.          IF NOT ZOK THEN _
  372.             RETURN
  373.       LastDnld = ZLastIndex
  374.       FirstDnld = ZAnsIndex
  375.       ZCmdTransfer$ = ""
  376.       IF ZAutoDownYes THEN _
  377.          ZCmdTransfer$ = "X"
  378.       ZAutoDownInProgress = ZAutoDownYes
  379.       ZAnsIndex = ZLastIndex
  380.       GOSUB 20470
  381.       LastDnld = LastDnld + (WasX > 0)
  382.       BatchBytes# = 0
  383.       BatchBlocks# = 0
  384.       ZDownFiles = 0
  385.       CALL KillWork (ZNodeWorkFile$)
  386.       ZErrCode = 0
  387.       FOR ZAnsIndex = FirstDnld TO LastDnld
  388.          GOSUB 20470
  389.          GOSUB 20205
  390.          ZCmdTransfer$ = ZWasFT$
  391.          CALL Line25
  392.          IF ZFileSysParm > 1 OR ZInternalProt$ = "N" THEN _
  393.             ZAnsIndex = LastDnld + 1
  394. 20203 NEXT
  395.       ZLastIndex = 0
  396.       IF ZFileSysParm > 1 THEN _
  397.          RETURN
  398.       ZBatchTransfer = ZFalse
  399.       ZCmdTransfer$ = ""
  400.       RETURN
  401. 20205 MarkingTime = (ZAnsIndex = FirstDnld OR NOT ZConcatFIles)
  402.       ZFileName$ = ZUserIn$(ZAnsIndex)
  403.       CALL Remove (ZFileName$,", ")
  404.       ZViolation$ = "Download "
  405.       IF PersonalDnld THEN _
  406.          CALL BreakFileName (ZFileName$,DR$,ZWasY$,WasX$,ZTrue) : _
  407.          ZFileNameHold$ = ZWasY$ + _
  408.                            WasX$ : _
  409.          GOTO 20235
  410.       ZFileNameHold$ = ZFileName$
  411.       CALL BadFile (ZFileName$,BadFileNameIndex)
  412.       ON BadFileNameIndex GOTO 20220,20231,20233
  413. 20220 IF INSTR (ZFileName$,".") = 0 THEN _
  414.          FileNameAlt$ = ZFileName$ : _
  415.          ZFileName$ = ZFileName$ + "." + ZDefaultExtension$ : _
  416.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$ _
  417.       ELSE FileNameAlt$ = ""
  418. 20222 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + _
  419.                       ((ZUserSecLevel < ZMinSecToView) OR _
  420.                        NOT ZCanDnldFromUp),MarkingTime,"D")          ' KG022204
  421. 20225 IF ZOK THEN _
  422.          GOTO 20235
  423.       IF ZDotFlag THEN _
  424.          RETURN
  425.       IF FileNameAlt$ <> "" THEN _
  426.          ZFileName$ = FileNameAlt$ : _
  427.          FileNameAlt$ = "" : _
  428.          ZFileNameHold$ = ZFileName$ : _
  429.          GOTO 20222
  430. 20231 ZOutTxt$ = ZFileNameHold$ + _
  431.            " not found!"
  432.       CALL UpdtCalr (ZOutTxt$,2)
  433.       IF ZAutoDownInProgress THEN _
  434.          ZOutTxt$ = ZOutTxt$ + _
  435.               " during AUTODOWNLOAD" : _
  436.          GOSUB 21640 : _
  437.          RETURN
  438.       ZOutTxt$ = ZOutTxt$ + _
  439.            " Correct name"+ZPressEnterExpert$
  440.       ZSuspendAutoLogoff = ZTrue
  441.       GOSUB 21660
  442.       ZSuspendAutoLogoff = ZFalse
  443.       IF ZFileSysParm > 1 THEN _
  444.          RETURN
  445.       IF ZWasQ=0 THEN _
  446.          IF ZBatchTransfer AND ZAnsIndex >= LastDnld THEN _
  447.             GOTO 20262 _
  448.          ELSE ZAutoLogOffReq = ZFalse : _
  449.               RETURN
  450.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  451.       GOTO 20205
  452. 20233 CALL SecViolation
  453.       IF ZDenyAccess THEN _
  454.          ZFileSysParm = 4 : _
  455.          RETURN
  456.       GOTO 20231
  457. 20235 CALL BadName (BadFileNameIndex)
  458.       ON BadFileNameIndex GOTO  20236,20245
  459. 20236 ZLine25$ = "(D) " + _
  460.                  ZWasZ$
  461.       IF ZAutoDownInProgress THEN _
  462.          MID$(ZLine25$,2,1) = "A"
  463. '
  464. ' *  TEST FOR DOWNLOAD SECURITY
  465. '
  466.       CALL OpenWork (2,ZFileSecFile$)
  467.       IF ZErrCode = 53 THEN _
  468.          CALL UpdtCalr ("Missing file " + ZFileSecFile$,2) : _
  469.          GOTO 20247
  470. 20242 IF EOF(2) THEN _
  471.          GOTO 20247
  472.       CALL ReadParms (ZWorkAra$(),3,1)
  473.       IF ZErrCode <> 0 THEN _
  474.          ZWasEL = 20242 : _
  475.          GOTO 21900
  476. 20243 CALL WildFile (ZWorkAra$(1),ZWasZ$,ZOK)
  477.       IF NOT ZOK THEN _
  478.          GOTO 20242
  479. 20244 IF ZUserSecLevel < VAL(ZWorkAra$(2)) THEN _
  480.          GOTO 20245
  481.       FilePswd$ = ZWorkAra$(3)
  482.       IF FilePswd$ = "" THEN _
  483.          GOTO 20247
  484.       CALL AllCaps (FilePswd$)
  485.       IF FilePswd$ = ZPswd$ THEN _
  486.          GOTO 20247
  487.       ZOutTxt$ = "Enter PASSWORD to download " + _
  488.            ZFileName$
  489.       GOSUB 21660
  490.       IF ZFileSysParm > 1 THEN _
  491.          RETURN
  492.       IF ZWasQ = 0 THEN _
  493.          RETURN
  494.       CALL AllCaps (ZUserIn$(1))
  495.       IF ZUserIn$(1) = FilePswd$ THEN _
  496.          GOTO 20247
  497. 20245 ZViolation$ = "DownLoad " + _
  498.                    ZFileName$
  499. 20246 CALL SecViolation
  500.       IF ZDenyAccess THEN _
  501.          ZFileSysParm = 4
  502.       RETURN
  503. 20247 ZWasDF = 0
  504.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  505.       IF ZAutoDownInProgress THEN _
  506.          ZUserIn$(ZAnsIndex) = WasX$ + "." + Extension$ : _          ' RH022501
  507.          ZOutTxt$ = "Transferring -- " + _
  508.               ZUserIn$(ZAnsIndex) : _                                ' RH022501
  509.          GOSUB 21640 : _
  510.          IF ZFileSysParm > 1 THEN _
  511.             RETURN
  512.       IF INSTR("...WRK.FW .ARC.EXE.COM.OBJ.WKS.LBR.ZIP.PAK.ZOO.LZH.","."+Extension$+".") > 2 OR _
  513.          MID$(Extension$,2,1) = "Q" OR _
  514.          (ZRequireNonASCII AND Extension$ = "BAS") THEN _
  515.             ZWasDF = ZTrue
  516. 20248 ZOutTxt$ = ""
  517.       IF ZBatchTransfer THEN _
  518.          IF ZAnsIndex < LastDnld THEN _
  519.             GOTO 20260
  520.       CALL XferType (2,ZTrue)
  521.       IF ZFF THEN _
  522.          GOTO 20260
  523.       CALL XferType (1,ZTrue)
  524.       IF ZSubParm = -1 THEN _
  525.          ZFileSysParm = 7 : _
  526.          RETURN
  527. 20260 ZTransferFunction = 1
  528.       GOSUB 21790
  529.       IF ZFileSysParm > 1 THEN _
  530.          RETURN
  531.       ZBatchTransfer = (ZBatchProto AND (LastDnld > FirstDnld))
  532.       IF ZBatchTransfer AND ZCmdTransfer$ = "" THEN _
  533.          ZCmdTransfer$ = ZWasFT$
  534.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  535.          20340, _              ' ASCII DOWNLOAD
  536.          20290, _              ' Xmodem
  537.          20290, _              ' Xmodem CRC
  538.          20270, _              ' YMODEM
  539.          21700                 ' NONE - CANCEL
  540. '
  541. ' *  EXTERNAL Protocol Downloads/Uploads
  542. '
  543. 20261 IF ZReq8Bit THEN _
  544.          IF NOT ZEightBit THEN _
  545.             GOSUB 20318 : _
  546.             IF ZFileSysParm > 1 THEN _
  547.                RETURN _
  548.             ELSE GOSUB 20992 : _
  549.                  IF ZFileSysParm > 1 THEN _
  550.                     RETURN
  551.       IF ZTransferFunction = 1 THEN _
  552.          GOSUB 20750 : _
  553.          CLOSE 2 : _
  554.          IF ZFileSysParm > 1 OR NOT ZOK THEN _
  555.             RETURN
  556. 20262 IF ZBatchTransfer THEN _
  557.          IF ZAnsIndex < LastDnld THEN _
  558.             RETURN _
  559.          ELSE ZBlocksInFile# = BatchBlocks# : _
  560.               ZBytesInFile# = BatchBytes# : _
  561.               ZNumDnldBytes! = BatchBytes# : _
  562.               IF ZBytesInFile# < 1 THEN _
  563.                  RETURN _
  564.               ELSE GOSUB 20780 : _
  565.                    IF ZFileSysParm > 1 OR NOT ZOK THEN _
  566.                       RETURN
  567.       IF ZAutoDownInProgress THEN _
  568.          CALL SendName : _
  569.          IF ZAbort THEN _
  570.             DnldCompleted = ZFalse : _
  571.             GOSUB 21760 : _
  572.             RETURN
  573.       GOSUB 20337                                                    ' XX081401
  574.       CALL Transfer
  575. 20263 IF ZPrivateDoor THEN _
  576.          ZCmdTransfer$ = ZWasFT$ : _
  577.          CALL XferType (2,ZTrue) : _
  578.          ZCmdTransfer$ = ""
  579.       CALL OpenWork (2,"XFER-" + ZNodeID$ + ".DEF")
  580.       IF ZErrCode <> 0 THEN _
  581.          GOTO 20267
  582.       CALL ReadParms (ZWorkAra$(), ZFailureParm, 1)
  583.       IF ZErrCode <> 0 THEN _
  584.          GOTO 20267
  585.       CLOSE 2                                                        ' KG040902
  586.       CALL KillWork ("XFER-" + ZNodeID$ + ".DEF")
  587. 20264 IF ZPrivateDoor THEN _
  588.          ZFileName$ = ZWorkAra$(1) : _
  589.          CALL BreakFileName (ZFileName$,WasX$,ZFileNameHold$,ZWasY$,ZTrue) : _
  590.          ZFileNameHold$ = ZFileNameHold$ + _
  591.                            ZWasY$
  592.       IF LEFT$(ZWorkAra$(ZFailureParm),1) = "L" THEN _
  593.          MID$(ZWorkAra$(ZFailureParm),1,1) = ZFailureString$
  594. 20265 IF ZTransferFunction = 2 THEN _
  595.          IF INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1 THEN _
  596.             GOTO 20700 _
  597.          ELSE GOTO 20730
  598.       IF ZTransferFunction = 1 THEN _
  599.          DnldCompleted = (INSTR(ZWorkAra$(ZFailureParm),ZFailureString$) <> 1)
  600.       GOSUB 21760
  601.       CALL Carrier
  602.       IF ZSubParm = -1 THEN _
  603.          ZFileSysParm = 7
  604.       RETURN
  605. '
  606. ' *  XFER FILE NOT Found
  607. '
  608. 20267 ZWasEL = 20263
  609.       GOTO 21900
  610.  
  611. '
  612. ' *  YMODEM DOWNLOAD DRIVER
  613. '
  614. 20270 GOTO 20292
  615. '
  616. ' *  Xmodem DOWNLOAD DRIVER
  617. '
  618. 20290 '
  619. 20292 GOSUB 20750
  620.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  621.          RETURN
  622.       WasA1$ = "SEND"
  623.       GOSUB 20320
  624.       IF ZFileSysParm > 1 THEN _
  625.          RETURN
  626.       IF ZLocalUser THEN _
  627.          CALL QuickTPut1 ("Protocol not available in local mode") : _
  628.          RETURN
  629.       IF ZAutoDownInProgress THEN _
  630.          GOSUB 20294 : _
  631.          IF ZAbort THEN _
  632.             RETURN
  633.       GOSUB 21300
  634.       IF ZFileSysParm > 1 THEN _
  635.          RETURN
  636.       ZOutTxt$ = ""
  637.       GOTO 20390
  638. 20294 CALL SendName
  639.       RETURN
  640. 20318 ZOutTxt$ = "Please Switch to N,8,1 for binary transfer"
  641.       GOSUB 21630
  642.       IF ZFileSysParm > 1 THEN _
  643.          RETURN
  644.       CALL DelayTime (3)
  645.       RETURN
  646. 20320 IF NOT ZEightBit THEN _
  647.          GOSUB 20318 : _
  648.          IF ZFileSysParm > 1 THEN _
  649.             RETURN
  650. 20325 IF ZCheckSum THEN _
  651.          ZNAK$ = CHR$(21) : _
  652.          SOL = 132 _
  653.       ELSE ZNAK$ = "C" : _
  654.            SOL = 133
  655. 20330 IF ZAutoDownInProgress THEN _
  656.          RETURN
  657.       GOSUB 20337                                                    ' KG032801
  658.       ZOutTxt$ = ZProtoPrompt$ + _
  659.             " " + WasA1$ + _
  660.             " of " + _
  661.             ZFileNameHold$ + _
  662.             " ready.  <Ctrl X> aborts"
  663.       GOSUB 21650
  664. 20335 IF ZTransferFunction = 1 THEN _
  665.          CALL Talk (8,ZOutTxt$) _
  666.       ELSE CALL Talk (9,ZOutTxt$)
  667.       RETURN
  668. 20337 IF ZProtoMacro$ <> "" THEN _                                   ' KG032801
  669.          ZGSRAra$(1) = MID$("DU ",ZTransferFunction,1) : _           ' KG032801
  670.          CALL MacroExe (ZProtoMacro$)                                ' KG032801
  671.       RETURN                                                         ' KG032801
  672. '
  673. ' *  ASCII DOWNLOAD DRIVER
  674. '
  675. 20340 IF ZWasDF THEN _
  676.          ZOutTxt$ = "Switch to a non-ascii protocol" : _
  677.          GOSUB 21650 : _
  678.          GOTO 21700
  679.       GOSUB 20750
  680.       IF ZFileSysParm > 1 OR NOT ZOK THEN _
  681.          RETURN
  682.       CALL OpenWork (2,ZFileName$)
  683.       IF (ZAnsIndex = FirstDnld OR NOT ZConcatFIles) THEN _
  684.          GOSUB 20337 : _                                             ' KG032801
  685.          ZOutTxt$ = "^X aborts.  ^S suspends ^Q resumes" : _
  686.          GOSUB 21640 : _
  687.          IF ZFileSysParm > 1 THEN _
  688.             RETURN _
  689.          ELSE ZOutTxt$ = ZProtoPrompt$ + " SEND of " + _
  690.               ZFileNameHold$ + _
  691.               " ready. Press Any Key to start" : _
  692.          ZTurboKey = 2 : _
  693.          ZForceKeyboard = ZTrue : _
  694.          ZSuspendAutologoff = ZTrue : _
  695.          GOSUB 21660 : _
  696.          ZSuspendAutologoff = ZFalse : _
  697.          GOSUB 20335 : _
  698.          IF ZFileSysParm > 1 THEN _
  699.             RETURN
  700. 20380 ZStopInterrupts = ZFalse
  701.       WasTU = 0
  702.       SWAP WasTU,ZPageLength
  703.       CALL BufFile (ZFileName$,WasX)
  704.       SWAP WasTU,ZPageLength
  705.       ZNonStop = (ZPageLength < 1)
  706.       IF StopFile THEN _
  707.          DnldCompleted = ZFalse : _
  708.          GOTO 20390
  709. 20381 IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  710.          CALL QuickTPut (CHR$(26),0) : _
  711.          IF NOT ZLocalUser AND ZSubParm = 0 THEN _
  712.             FOR WasX = 1 TO 5 : _
  713.                CALL PutCom (CHR$(7)) : _
  714.                CALL DelayTime (3) : _
  715.             NEXT
  716. 20385 DnldCompleted = ZTrue
  717. 20390 GOTO 21760
  718. '
  719. ' *  U - COMMAND FROM FILES MENU (UPLOAD)
  720. '
  721. 20395 GOSUB 21640
  722.       IF ZFileSysParm > 1 THEN _
  723.          RETURN
  724.       ZOutTxt$ = "Correct name of file to upload" + _
  725.            ZPressEnterExpert$
  726.       GOSUB 21660
  727.       IF ZFileSysParm > 1 THEN _
  728.          RETURN
  729.       IF ZWasQ = 0 THEN _
  730.          RETURN
  731.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  732.       GOTO 20435
  733. 20400 CALL TimeBack (1)
  734.       GOSUB 20420
  735.       ZAutoLogOffReq = 0
  736.       FirstUpld = ZAnsIndex
  737.       GOTO 20430
  738. 20420 ZOutTxt$ = "Upload what file(s)"
  739.       ZStackC = ZTrue
  740.       GOSUB 21668
  741.       RETURN
  742. '
  743. ' *  SEARCH FOR DUPLICATE FILENAME
  744. '
  745. 20430 ZAnsIndex = ZLastIndex
  746.       GOSUB 20470
  747.       ZLastIndex = ZLastIndex + (WasX > 0)
  748.       LastUpld = ZLastIndex                                          ' KG072702
  749. 20432 FOR ZAnsIndex = FirstUpld TO LastUpld                          ' KG072702
  750.          GOSUB 20470
  751.          GOSUB 20435
  752.          FirstUpld = FirstUpld + 1                                   ' KG072702
  753.          IF ZFileSysParm > 1 THEN _
  754.             ZAnsIndex = LastUpld + 1                                 ' KG072702
  755.       NEXT
  756.       ZCmdTransfer$ = ""
  757.       RETURN
  758. 20435 ZFileNameHold$ = ZUserIn$(ZAnsIndex)
  759.       ExtSrch = ZFalse                                               ' ML080601
  760.       IF INSTR(ZFileNameHold$,".") = 0 THEN _
  761.          ZFileNameHold$ = ZFileNameHold$ + "." + ZDefaultExtension$
  762.       CALL AllCaps(ZFileNameHold$)
  763.       ZFileName$ = ZFileNameHold$
  764.       ZViolation$ = "Upload "
  765.       CALL NoPath (ZFileName$,BadFileNameIndex)
  766.       IF BadFileNameIndex THEN _
  767.          GOTO 20451
  768.       CALL BadFile (ZFileName$,BadFileNameIndex)
  769.       ON BadFileNameIndex GOTO 20440,20451,20515
  770. 20440 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount,ZTrue,"U")  ' KG022204
  771. 20445 IF ZOK THEN _
  772.          GOTO 20452
  773.       IF INSTR(ZFileName$,".") = 0 THEN _
  774.          GOTO 20475
  775.       CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZFalse)
  776.       WasI = 1
  777. 20447 WasJ = INSTR(MID$(ZCompressedExt$+". ",WasI),".")
  778.       IF WasJ = 0 THEN _
  779.          GOTO 20475
  780.       Check$ = MID$(ZCompressedExt$,WasI,WasJ-1)
  781.       WasI = WasI + WasJ
  782. 20450 IF Extension$ <> Check$ THEN _
  783.          CALL RotorsDir (WasX$ + "." + Check$,ZSubDir$(),ZSubDirCount,ZTrue,"U") : _ ' KG021802
  784.          IF ZOK THEN _
  785.             ExtSrch = ZTrue : _                                      ' ML080601
  786.             GOTO 20452
  787.       GOTO 20447
  788. 20451 ZOutTxt$ = "Invalid file name <" + ZFileName$ + ">"
  789.       GOTO 20395
  790. 20452 IF ZUserSecLevel < ZOverWriteSecLevel THEN _
  791.          GOTO 20453
  792.       IF ExtSrch AND (WasX$ + "." + Check$) <> ZFileName$ THEN _     ' ML080601
  793.          ZOutTxt$ = WasX$ + "." + Check$ + " already here, " + _     ' ML080601
  794.                     "upload anyway (Y,[N])" _                        ' ML080601
  795.       ELSE ZOutTxt$ = "Overwrite file (Y,[N])"                       ' ML080601
  796.       GOSUB 21660
  797.       IF ZFileSysParm > 1 THEN _
  798.          RETURN
  799.       IF NOT ZYes THEN _
  800.          GOTO 20453
  801.       ZWasZ$ = ZFileName$
  802.       CALL KillWork (ZFileName$)
  803.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _                     ' ML080601
  804.          ZOutTxt$ = "Unable to overwrite" : _                        ' ML080601
  805.          GOSUB 21660 : _                                             ' ML080601
  806.          RETURN                                                      ' ML080601
  807.       GOTO 20475
  808. 20453 CLOSE 2
  809.       IF ZUserSecLevel >= ZAddDirSecurity THEN _
  810.          GOTO 20455
  811. 20454 CALL QuickTPut1 ("Thanks, but we already have " + ZFileNameHold$)
  812.       CALL UpdtCalr ("Upload duplicate " + ZFileNameHold$,1)
  813.       RETURN
  814. 20455 ZOutTxt$ = "Add new directory entry (Y,[N])"
  815.       ZTurboKey = - ZTurboKeyUser
  816.       GOSUB 21660
  817.       IF ZFileSysParm > 1 THEN _
  818.          RETURN
  819.       IF NOT ZYes THEN _
  820.          RETURN
  821.       AddingDescOnly = ZTrue
  822.       ZWasFT$ = "l"
  823.       GOSUB 20702
  824.       RETURN
  825. 20470 ' *** CHECK FOR Protocol IN FILE LIST ***
  826.       ZWasZ$ = ZUserIn$(ZAnsIndex)
  827.       CALL AllCaps(ZWasZ$)
  828.       WasX = 0
  829.       IF LEN (ZWasZ$) = 1 THEN _
  830.          WasX = INSTR(ZDefaultXfer$,ZWasZ$) : _
  831.          IF WasX > 0 THEN _
  832.             ZAnsIndex = ZAnsIndex + 1 : _
  833.             ZCmdTransfer$ = ZWasZ$ : _
  834.             ZAutoDownInProgress = ZFalse : _
  835.             IF MID$(ZInternalEquiv$,WasX,1) = "N" THEN _
  836.                ZCmdTransfer$ = ""
  837.       RETURN
  838. 20475 ZWasZ$ = ZUpldDriveFile$
  839.       CALL FindFree
  840.       IF VAL(ZFreeSpace$) < 4096 THEN _
  841.          CALL QuickTPut1 ("No room for uploads.  Try tomorrow.") : _
  842.          ZAnsIndex = ZLastIndex + 1 : _
  843.          RETURN
  844.       ZOutTxt$ = "Upload disk has" + _
  845.            ZFreeSpace$
  846.       GOSUB 21640
  847.       IF ZFileSysParm > 1 THEN _
  848.          RETURN
  849.       ZLine25$ = "(U) " + _
  850.                  ZFileNameHold$
  851.       ZSubParm = 2
  852.       CALL Line25
  853.       ZOutTxt$ = ""
  854.       ZOK = ZTrue
  855. 20477 CALL XferType (2,ZTrue)
  856.       IF ZFF THEN _
  857.          GOTO 20500
  858.       CALL XferType (1,ZTrue)
  859.       IF ZSubParm = -1 THEN _
  860.          ZFileSysParm = 7 : _
  861.          RETURN
  862. 20500 ZTransferFunction = 2
  863.       ZAutoDownInProgress = ZFalse
  864.       GOSUB 21790
  865.       IF ZFileSysParm > 1 THEN _
  866.          RETURN
  867.       ON INSTR("AXCYN",ZInternalProt$) GOTO _
  868.          20560, _         ' ASCII UPLOAD
  869.          20542, _         ' Xmodem
  870.          20542, _         ' Xmodem CRC
  871.          20542, _         ' YMODEM
  872.          20735            ' NONE - CANCEL
  873.       GOTO 20261
  874. 20510 WasD$ = "<Esc> by SYSOP aborts"
  875.       GOSUB 21710
  876.       RETURN
  877. 20515 CALL SecViolation
  878.       IF ZDenyAccess THEN _
  879.          ZFileSysParm = 4 : _
  880.          RETURN
  881.       GOTO 20420
  882. '
  883. ' *  Xmodem/YMODEM UPLOAD DRIVER
  884. '
  885. 20542 WasA1$ = "RECEIVE"
  886.       GOSUB 20320
  887.       IF ZFileSysParm > 1 THEN _
  888.          RETURN
  889.       ZOK = ZTrue
  890.       GOSUB 20860
  891.       IF ZFileSysParm > 1 THEN _
  892.          RETURN
  893.       IF ZOK THEN _
  894.          GOTO 20700
  895.       GOTO 20730
  896. '
  897. ' *  ASCII UPLOAD
  898. '
  899. 20560 LineACK = (ZDefaultLineACK$ <> "")
  900.       IF LineACK THEN _
  901.          ZOutTxt$ = "Acknowledge each line ([Y],N)" : _
  902.          ZTurboKey = - ZTurboKeyUser : _
  903.          LineACK = NOT ZNo : _
  904.          GOSUB 21660 : _
  905.          IF ZFileSysParm > 1 THEN _
  906.             RETURN
  907.       GOSUB 20337                                                    ' KG032801
  908.       CALL QuickTPut1 ("Transfer MUST end with a <Ctrl-K>")
  909.       CALL QuickTPut1 (ZProtoPrompt$+" RECEIVE of " + ZFileNameHold$ + " ready")
  910.       ZOK = ZFalse
  911.       XOff = ZFalse
  912.       CALL OpenOutW(ZFileName$)
  913.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  914.          ZWasEL = 20560 : _
  915.          GOTO 21900
  916.       GOSUB 20510
  917.       IF ZFileSysParm > 1 THEN _
  918.          RETURN
  919. 20600 CALL EofComm (Char)
  920.       WHILE Char <> -1
  921.          CALL Carrier
  922.          IF ZSubParm = -1 THEN _
  923.             ZFileSysParm = 7 : _
  924.             RETURN
  925.          IF NOT ZFossil THEN _
  926.             IF LOF(3) < 512 THEN _
  927.                CALL PutCom(ZXOff$) : _
  928.                XOff = ZTrue
  929. 20610    CALL FlushCom (WasX$)
  930.          IF ZSubParm = -1 THEN _
  931.             ZFileSysParm = 7 : _
  932.             RETURN
  933.          IF INSTR(WasX$,CHR$(11)) THEN _
  934.             GOTO 20650
  935.          ZOK = ZTrue
  936. 20620    CALL PrintWork (WasX$)
  937.          IF LineACK THEN _
  938.             IF INSTR(WasX$,CHR$(10)) > 0 THEN _
  939.                CALL PutCom (ZDefaultLineACK$)
  940.          IF ZErrCode <> 0 THEN _
  941.             ZWasEL = 20620 : _
  942.             GOTO 21900
  943.          WasD$ = WasX$
  944.          NumReturns = 0
  945.          GOSUB 21720
  946.          IF ZFileSysParm > 1 THEN _
  947.             RETURN
  948. 20621    CALL FindFKey
  949.          IF ZSubParm < 0 THEN _
  950.             ZFileSysParm = 2 : _
  951.             RETURN
  952.          IF ZKeyPressed$ = ZEscape$ THEN _
  953.             GOTO 20745
  954.          IF NOT ZOK THEN _
  955.             GOTO 20670
  956.       CALL EofComm (Char)
  957. 20630 WEND
  958.       CALL Carrier
  959.       IF ZSubParm = -1 THEN _
  960.          ZFileSysParm = 7 : _
  961.          RETURN
  962.       IF XOff THEN _
  963.          XOff = ZFalse : _
  964.          CALL PutCom (ZXOn$) : _
  965.          IF ZErrCode <> 0 THEN _
  966.             ZWasEL = 20630 : _
  967.             GOTO 21900
  968.       GOTO 20600
  969. 20650 WasX = INSTR(WasX$,CHR$(11))
  970.       IF WasX = 1 THEN _
  971.          IF NOT ZOK THEN _
  972.             GOTO 20730 _
  973.          ELSE GOTO 20700
  974.       CALL PrintWorkA (LEFT$(WasX$,WasX-1))
  975.       IF ZErrCode <> 0 THEN _
  976.          ZWasEL = 20650 : _
  977.          GOTO 21900
  978.       GOTO 20700
  979. 20670 ZOutTxt$ = ZXOff$ + _
  980.            "System error! Upload aborted <Ctrl-K> continues"
  981. 20675 GOSUB 21650
  982.       IF ZFileSysParm > 1 THEN _
  983.          RETURN
  984.       CALL DelayTime (3)
  985.       CALL PutCom(ZXOn$)
  986. 20680 CALL EofComm (Char)
  987.       WHILE Char <> -1
  988.          CALL FlushCom(WasX$)
  989.          IF INSTR(WasX$,CHR$(11)) THEN _
  990.             GOTO 20730
  991. 20685    CALL Carrier
  992.          IF ZSubParm = -1 THEN _
  993.             ZFileSysParm = 7 : _
  994.             RETURN
  995.       CALL EofComm (Char)
  996.       WEND
  997.       GOTO 20680
  998. '
  999. ' *  UPDATE UPLOAD DIRECTORY
  1000. '
  1001. 20700 GOSUB 21780
  1002.       IF ZFileSysParm > 1 THEN _
  1003.          RETURN
  1004. 20702 CALL UpdtUpload (ZCategoryName$(),ZCategoryCode$(), ZLinesInMsg)
  1005.       ZPrivateDoor = ZFalse
  1006.       IF NOT ZGetExtDesc THEN _
  1007.          GOTO 20710
  1008.       ZMsgHeader$ = "Extended Description for " + ZFileNameHold$
  1009.       ZSysopComment = ZTrue
  1010.       ZMaxMsgLines = ZMaxExtendedLines
  1011.       WasLL = ZRightMargin
  1012.       ZRightMargin = 30 + ZMaxDescLen
  1013.       ZFileSysParm = 5
  1014.       RETURN
  1015. 20705 ZMaxMsgLines = ZMaxMsgLinesDef
  1016.       ZRightMargin = WasLL
  1017.       GOSUB 20702                                                    ' KG072702
  1018.       GOTO 20432                                                     ' KG072702
  1019. 20710 AddingDescOnly = ZFalse
  1020.       IF ZBytesInFile# > 0.0 THEN _
  1021.          GOTO 21770
  1022. 20730 GOSUB 21780
  1023.       CALL QuickTPut1 ("Upload aborted")
  1024.       ZPrivateDoor = ZFalse
  1025. 20735 CALL KillWork (ZFileName$)
  1026.       IF ZErrCode <>0 THEN _
  1027.          ZWasEL = 20736 : _
  1028.          GOTO 21900
  1029.       ZAnsIndex = ZLastIndex + 1                                     ' KG031501
  1030.       ZLastIndex = 0
  1031.       RETURN
  1032. '
  1033. ' *  Sysop ABORTED UPLOAD
  1034. '
  1035. 20745 ZOutTxt$ = ZXOff$ + _
  1036.            "SYSOP aborted upload. Stop transfer. <Ctrl-K> continues" ' KG081701
  1037.       GOTO 20675
  1038. '
  1039. ' *  CALCULATE DOWNLOAD TIME ESTIMATE
  1040. '
  1041. 20750 ZStartOfHeader$ = CHR$(1 - (ZInternalProt$ = "Y"))
  1042.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,ZFLen)
  1043. 20760 IF ZErrCode <> 0 THEN _
  1044.          CALL QuickTPut1 ("Unable to access "+ZFileNameHold$) : _
  1045.          CALL UpdtCalr ("Unable to access "+ZFileName$,2) : _
  1046.          ZOK = ZFalse : _
  1047.          ZErrCode = 0 : _
  1048.          ZBytesInFile# = 0 : _
  1049.          RETURN
  1050.       ZBytesInFile# = LOF(2)
  1051.       ZNumDnldBytes! = LOF(2)
  1052.       ZOK = ZTrue
  1053.       IF SizeOnly THEN _
  1054.          SizeOnly = ZFalse : _
  1055.          RETURN
  1056.       ZBlocksInFile# = MaxBlock
  1057.       IF ZBatchTransfer THEN _
  1058.          Temp# = BatchBlocks# + ZBlocksInFile# : _
  1059.          CALL CheckTimeRemain (MinsRemaining) : _
  1060.          IF (NOT PersonalDnld) AND _
  1061.             (INT(Temp# / 60) + 1 > MinsRemaining) THEN _
  1062.             CALL QuickTPut1 ("Omitting " + ZFileNameHold$ + ".  Insufficient time") : _
  1063.             ZAutoLogoffReq = ZFalse : _                              ' KG073001
  1064.             RETURN _
  1065.          ELSE BatchBlocks# = Temp# : _
  1066.               BatchBytes# = BatchBytes# + ZBytesInFile# : _
  1067.               CALL OpenWorkA (ZNodeWorkFile$) : _
  1068.               CALL PrintWorkA (ZFileName$) : _
  1069.               ZDownFiles = ZDownFiles + 1 : _
  1070.               RETURN
  1071.       ZDownFiles = 1
  1072. 20780 ZOutTxt$ = "File Size    :"
  1073.       ZOK = ZTrue
  1074.       IF ZBlockSize > 0 THEN _
  1075.          ZOutTxt$ = ZOutTxt$ + _
  1076.               STR$(FIX(ZBlocksInFile#)) + _
  1077.               " blocks "
  1078. 20785 ZBlocksInFile# = ZBlocksInFile# / _
  1079.                         VAL(MID$("00000300045012002400480096019203840", -4 * ZBPS, 4))
  1080.       ZBlocksInFile# = ZBlocksInFile# * ZFLen / ZSpeedFactor!
  1081.       IF (ZAnsIndex > 1 AND ZConcatFIles) THEN _
  1082.          RETURN
  1083.       ZOutTxt$ = ZOutTxt$ + _
  1084.            STR$(ZBytesInFile#) + _
  1085.            " bytes"
  1086.       GOSUB 21650
  1087.       IF ZFileSysParm > 1 THEN _
  1088.          RETURN
  1089.       IF ZBytesInFile# < 1 THEN _
  1090.          RETURN
  1091. 20790 ZSubParm = 2
  1092.       CALL Line25
  1093.       ZOutTxt$ = "Transfer Time:" + _
  1094.          STR$(INT(ZBlocksInFile# / 60)) + _
  1095.          " min," + _
  1096.          STR$(INT(ZBlocksInFile# - (INT(ZBlocksInFile# / 60) * 60))) + _
  1097.          " sec (approx)"
  1098.       GOSUB 21650
  1099.       IF ZFileSysParm > 1 THEN _
  1100.          RETURN
  1101. 20791 IF PersonalDnld THEN _
  1102.          RETURN
  1103.       CALL CheckTimeRemain (MinsRemaining)
  1104.       IF ZSubParm = -1 THEN _
  1105.          ZFileSysParm = 6 : _
  1106.          RETURN
  1107.       ZOK = ZTrue
  1108.       IF (INT(ZBlocksInFile# / 60) + 1) > MinsRemaining THEN _
  1109.          ZOutTxt$ = "Not enough time left!" : _
  1110.          CALL UpdtCalr (ZFileName$ + " " + ZOutTxt$,2) : _
  1111.          CALL QuickTPut1 (ZOutTxt$): _
  1112.          ZOutTxt$ = "" : _
  1113.          ZOK = ZFalse : _
  1114.          ZAutoLogoffReq = ZFalse : _
  1115.          RETURN
  1116.       IF ZRatioRestrict# > 0 THEN _
  1117.          CALL QuickTPut1 ("New statistics will be") : _
  1118.          CALL CheckRatio (ZTrue)
  1119.       RETURN
  1120. 20810 ZDelay! = TIMER + 6
  1121. 20840 CALL EofComm (Char)
  1122.       IF Char = -1 THEN _
  1123.          GOTO 20850
  1124.       CALL FlushCom(ZWasY$)
  1125.       RETURN
  1126. 20850 CALL CheckTime (ZDelay!, TempElapsed!, 1)
  1127.       IF TempElapsed! > 0 THEN GOTO 20840
  1128. 20851 ZWasY$ = ""
  1129.       CALL CheckCarrier
  1130.       IF ZSubParm = -1 THEN _
  1131.          ZFileSysParm = 7 : _
  1132.          RETURN
  1133.       RETURN
  1134. '
  1135. ' *  Xmodem/YMODEM UPLOAD
  1136. '
  1137. 20860 GOSUB 20992
  1138.       IF ZFileSysParm > 1 THEN _
  1139.          RETURN
  1140.       IF NOT ZEightBit THEN _
  1141.          GOSUB 21280 : _
  1142.          IF ZFileSysParm > 1 THEN _
  1143.             RETURN
  1144. 20900 WasX$ = ""
  1145.       Sec = 1
  1146.       'CALL OpenOutW (ZFileName$)
  1147.       IF ZFLen > ZWriteBufDef THEN _
  1148.          WriteBuf = ZFLen _
  1149.       ELSE WriteBuf = ZWriteBufDef
  1150.       CALL OpenRSeq (ZFileName$,WasY,ZWasDF,WriteBuf)
  1151.       IF ZErrCode <> 0 AND ZErrCode <> 53 THEN _
  1152.          ZWasEL = 20900 : _
  1153.          GOTO 21900
  1154.       FIELD #2, WriteBuf AS ZUpldRec$
  1155.       RecsWrit = 0
  1156.       NumInBuff = 0
  1157.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1158.       Year$ = " " + _
  1159.             CHR$(1) + _
  1160.             CHR$(2) + _
  1161.             ZEndTransmission$ + _
  1162.             ZCancel$
  1163. 20903 CALL PutCom (ZNAK$)
  1164. 20920 WasX = 1
  1165. 20922 CALL CheckCarrier
  1166.       IF ZSubParm = -1 THEN _
  1167.          ZFileSysParm = 7 : _
  1168.          RETURN
  1169.       CALL FindFKey
  1170.       IF ZKeyPressed$ = ZEscape$ THEN _
  1171.          GOSUB 20510 :_
  1172.          IF ZFileSysParm > 1 THEN _
  1173.             RETURN _
  1174.          ELSE GOTO 21240
  1175.       GOSUB 20810
  1176.       IF ZFileSysParm > 1 THEN _
  1177.          RETURN
  1178. 20930 WasJ = INSTR(Year$,LEFT$(ZWasY$,1))
  1179.       ON WasJ GOTO 20960,20999,20999,21220,21230
  1180. 20960 IF ZWasY$ <> "" THEN _
  1181.          GOSUB 21280 : _
  1182.          IF ZFileSysParm > 1 THEN _
  1183.             RETURN _
  1184.          ELSE CALL CheckTime (TransferAbort!,TempElapsed!,1) : _
  1185.               ON ZSubParm GOTO 20920,21230
  1186. 20970 WasX = WasX + 1
  1187.       CALL DelayTime (1)
  1188.       CALL PutCom (ZNAK$)
  1189.       IF WasX < 6 THEN _
  1190.          GOTO 20922
  1191.       WasD$ = "Upload Timeout"
  1192.       GOSUB 21710
  1193.       IF ZFileSysParm > 1 THEN _
  1194.          RETURN
  1195.       CALL CheckTime (TransferAbort!,TempElapsed!,1)
  1196.       ON ZSubParm GOTO 20990,21230
  1197. 20990 GOTO 20920
  1198. '
  1199. ' *  CHANGE TO 8 BIT FOR Xmodem
  1200. '
  1201. 20992 GOSUB 20510
  1202.       IF ZFileSysParm > 1 THEN _
  1203.          ZFileSysParm = 2 : _
  1204.          RETURN
  1205.       IF NOT ZEightBit THEN _
  1206.          PrevLineCntl = INP (ZLineCntlReg) : _
  1207.          CALL DelayTime (3) : _
  1208.          SwitchToEight = ZTrue : _
  1209.          OUT ZLineCntlReg,3
  1210. 20996 WasSO = 0
  1211.       RETURN
  1212. '
  1213. ' *  EXPECTED BLOCK LENGTH. 132 FOR CheckSum, 133 FOR CRC, 1029 FOR YMODEM
  1214. '
  1215. 20999 SOL = 896 * WasJ - 1659 + ZCheckSum
  1216.       DataSol = 128 - (SOL > 1024)*896
  1217.       GOTO 21020
  1218. '
  1219. ' *  Xmodem/YMODEM UPLOAD
  1220. '
  1221. 21000 GOSUB 20810
  1222.       IF ZFileSysParm > 1 THEN _
  1223.          RETURN
  1224.       IF ZWasY$ = "" THEN _
  1225.          WasD$ = "Upload Timeout" : _
  1226.          GOSUB 21710 : _
  1227.          IF ZFileSysParm > 1 THEN _
  1228.             RETURN _
  1229.          ELSE GOTO 21040
  1230. 21020 WasX$ = WasX$ + _
  1231.            ZWasY$
  1232.       IF LEN(WasX$) < SOL THEN _
  1233.          GOTO 21000
  1234. 21040 IF LEN(WasX$) = SOL THEN _
  1235.          GOTO 21090
  1236. 21050 IF LEN(WasX$) > SOL THEN _
  1237.          GOTO 21180
  1238. 21060 IF WasX$ = ZEndTransmission$ THEN _
  1239.          GOTO 21220
  1240. 21070 IF WasX$ = ZCancel$ THEN _
  1241.          GOTO 21230
  1242. 21080 GOTO 21170
  1243. 21090 WasJX = ASC(MID$(WasX$,2,1))
  1244.       IF Sec = WasJX THEN _
  1245.          GOTO 21100
  1246.       GOTO 21200
  1247. 21100 IF (Sec XOR 255) <> ASC(MID$(WasX$,3,1)) THEN _
  1248.          GOTO 21210
  1249. 21110 IF ZCheckSum THEN _
  1250.          WasWK$ = MID$(WasX$,4,128) : _
  1251.          GOSUB 21750 : _
  1252.          IF ZFileSysParm > 1 THEN _
  1253.             RETURN _
  1254.          ELSE IF XmodemChecksum <> ASC(MID$(WasX$,132,1)) THEN _
  1255.             GOTO 21190 _
  1256.          ELSE GOTO 21120
  1257.       WasWK$ = MID$(WasX$,4)
  1258.       GOSUB 21750
  1259.       IF ZFileSysParm > 1 THEN _
  1260.          RETURN
  1261. 21113 IF CRCValue <> 0 THEN _
  1262.          GOTO 21191
  1263. 21120 WasSO = WasSO + 1
  1264.       CALL PutCom (ZAcknowledge$)
  1265. 21131 IF NumInBuff >= WriteBuf THEN _
  1266.          NumInBuff = 0 : _
  1267.          CALL PutWork (ZUpldRec$,RecsWrit,WriteBuf) : _
  1268.          IF ZErrCode <> 0 THEN _
  1269.             ZWasEL = 21131 : _
  1270.             GOTO 21900
  1271.       MID$(ZUpldRec$,NumInBuff+1,DataSol) = WasWK$
  1272.       NumInBuff = NumInBuff + DataSol
  1273. 21145 Sec = 255 AND (Sec + 1)
  1274.       CALL QuickLPrnt ("OK Rec Blk #",WasSO)
  1275. 21150 WasX$ = ""
  1276.       XmodemChecksum = 0
  1277.       TransferAbort! = TIMER + 45
  1278.       GOTO 20920
  1279. 21170 ZOutTxt$ = "Short Blk #"
  1280.       GOTO 21212
  1281. 21180 ZOutTxt$ = "Long Blk #"
  1282.       GOTO 21212
  1283. 21190 ZOutTxt$ = "Chksum Error #"
  1284.       GOTO 21212
  1285. 21191 ZOutTxt$ = "CRC Error"
  1286.       GOTO 21212
  1287. 21200 IF Sec < WasJX THEN _
  1288.          ZOutTxt$ = "Blk # Error in #" : _
  1289.          GOTO 21212
  1290.       CALL PutCom (RIGHT$(ZAckChar$,1 - (WasJX = 0)))
  1291.       GOTO 21150
  1292. 21210 ZOutTxt$ = "Complement Error in #"
  1293. 21212 CALL PutCom (ZNAK$)
  1294.       CALL LPrnt(ZLineFeed$ + ZOutTxt$ + STR$(WasSO + 1),0)
  1295.       GOTO 21150
  1296. 21220 IF NumInBuff < 1 THEN _
  1297.          GOTO 21225
  1298.       WasWK$ = LEFT$(ZUpldRec$,NumInBuff)
  1299.       CALL OpenRSeq (ZFileName$,MaxBlock,ZWasDF,128)
  1300.       FIELD #2, 128 AS ZUpldRec$
  1301.       MaxBlock = CDBL(RecsWrit) * WriteBuf / 128
  1302.       FOR WasI = 1 TO NumInBuff/128
  1303.          CALL PutWork (MID$(WasWK$,128*WasI-127,128),MaxBlock,128)
  1304.          IF ZErrCode > 0 THEN _
  1305.             ZWasEL = 21220 : _
  1306.             GOTO 21900
  1307.       NEXT
  1308.       CLOSE 2
  1309. 21225 CALL PutCom (ZAcknowledge$)
  1310.       GOTO 21250
  1311. 21230 WasD$ = ZLineFeed$ + _
  1312.            "Transfer Aborted"
  1313.       GOSUB 21710
  1314.       IF ZFileSysParm > 1 THEN _
  1315.          RETURN
  1316. 21240 CALL EofComm (Char)
  1317.       IF Char <> -1 THEN _
  1318.          GOSUB 21280 : _
  1319.          IF ZFileSysParm > 1 THEN _
  1320.             RETURN _
  1321.          ELSE CALL DelayTime (1) : _
  1322.          GOTO 21240
  1323.       CALL PutCom (ZCancel$ + ZCancel$)
  1324.       CALL DelayTime (1)
  1325.       CALL EofComm (Char)
  1326.       IF Char <> -1 THEN _
  1327.          GOTO 21240
  1328.       ZOK = ZFalse
  1329. 21250 ZEightBit = ZTrue
  1330.       RETURN
  1331. '
  1332. ' *  CLEAR GARBAGE OUT OF COMMUNICATIONS BUFFER
  1333. '
  1334. 21280 CALL CheckCarrier
  1335.       IF ZSubParm = -1 THEN _
  1336.          ZFileSysParm = 7 : _
  1337.          RETURN
  1338.       CALL EofComm (Char)
  1339.       IF Char = -1 THEN _
  1340.          RETURN
  1341. 21281 CALL FlushCom(ZWasDF$)
  1342.       'IF ZSubParm = -1 THEN _
  1343.       '   ZFileSysParm = 7 : _
  1344.       '   RETURN
  1345.       GOTO 21280
  1346. '
  1347. ' *  Xmodem/YMODEM DOWNLOAD
  1348. '
  1349. 21300 GOSUB 20992
  1350.       IF ZFileSysParm > 1 THEN _
  1351.          RETURN
  1352.       Sec = 0
  1353.       GOSUB 21280
  1354.       IF ZFileSysParm > 1 THEN _
  1355.          RETURN
  1356.       ZNAK$ = CHR$(21)
  1357.       TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1358. 21303 FIELD 2,ZFLen AS ZDnldRecord$
  1359. '
  1360. ' *  ROUTINE TO START AN "Xmodem" OR "YMODEM" DOWNLOAD.  CHECK'S INITIAL
  1361. ' *  "HANDSHAKE" TO SEE IF CHARACTER IS SENT IS A:
  1362. ' *           "X" = Xmodem WITH CheckSum AND 128 CHARACTER RECORDS
  1363. ' *           "C" = Xmodem WITH CRC CHECK AND 128 CHARACTER RECORDS
  1364. ' *           "Y" = YMODEM WITH CRC CHECK AND 1024 CHARACTER RECORDS
  1365. '
  1366. 21350 CALL EofComm (Char)
  1367.       WHILE Char <> -1
  1368. 21360    CALL GetCom(ZWasY$)
  1369.          IF ZWasY$ = ZCancel$ THEN _
  1370.             GOTO 21560
  1371. 21380    ZCheckSum = (ZWasY$ = ZNAK$)
  1372.          IF ZCheckSum THEN _
  1373.             ZFF = INSTR(ZInternalEquiv$,"X") : _
  1374.             IF ZFF > 0 THEN _
  1375.                ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1) : _
  1376.                GOTO 21480 _
  1377.             ELSE ZWasFT$ = "X" : _
  1378.                  GOTO 21480 _
  1379.          ELSE IF ZWasY$ = "C" THEN _
  1380.                  GOTO 21480
  1381.          CALL EofComm (Char)
  1382. 21390 WEND
  1383.       GOSUB 21460
  1384.       IF ZFileSysParm > 1 THEN _
  1385.          RETURN
  1386.       IF ZKeyPressed$ = ZEscape$ THEN _
  1387.          RETURN
  1388.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1389.       ON ZSubParm GOTO 21350,21455
  1390. 21410 TransferAbort! = TIMER + ZWaitBeforeDisconnect
  1391. '
  1392. ' *  ROUTINE TO WAIT FOR AN ACKNOWLEDGEMENT ON AN "Xmodem" OR "YMODEM"
  1393. ' *  DOWNLOAD
  1394. '
  1395. 21415 CALL EofComm (Char)
  1396.       IF Char <> -1 THEN _
  1397.          GOTO 21420
  1398.       GOSUB 21460
  1399.       IF ZFileSysParm > 1 THEN _
  1400.          RETURN
  1401.       IF ZKeyPressed$ = ZEscape$ THEN _
  1402.          RETURN
  1403.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1404.       ON ZSubParm GOTO 21415,21455
  1405. 21420 CALL GetCom(ZWasY$)
  1406.       IF ZWasY$ = ZAcknowledge$ THEN _
  1407.          GOTO 21470
  1408. 21440 IF ZWasY$ <> ZNAK$ THEN _
  1409.          GOTO 21450
  1410. 21443 WasD$ = ZLineFeed$ + _
  1411.          "Error -> retrans #" + _
  1412.          STR$(WasSO)
  1413.       GOSUB 21710
  1414.       IF ZFileSysParm > 1 THEN _
  1415.          RETURN
  1416. 21445 WasSO = WasSO - 1
  1417.       GOTO 21490
  1418. 21450 IF ZWasY$ = ZCancel$ THEN _
  1419.          IF HaveACancel THEN _
  1420.             GOTO 21560 _
  1421.          ELSE HaveACancel = ZTrue
  1422.       CALL CheckTime (TransferAbort!, TempElapsed!, 1)
  1423.       ON ZSubParm GOTO 21415,21455
  1424. 21455 WasD$ = "Download timeout"
  1425.       GOSUB 21710
  1426.       IF ZFileSysParm > 1 THEN _
  1427.          RETURN
  1428.       GOTO 21560
  1429. 21460 CALL CheckCarrier
  1430.       CALL FindFKey
  1431.       IF ZSubParm < 0 THEN _
  1432.          ZFileSysParm = 7 : _
  1433.          RETURN
  1434.       IF ZKeyPressed$ = ZEscape$ THEN _
  1435.          GOTO 21540
  1436.       RETURN
  1437. '
  1438. ' *  DISPLAY BLOCK SENT OK AND THEN READ IN NEXT RECORD FROM DISK TO DOWNLOAD
  1439. '
  1440. 21470 CALL QuickLPrnt ("OK Sent Blk #",WasSO)
  1441. 21480 IF LOC(2) => MaxBlock THEN _
  1442.          GOTO 21530
  1443.       CALL GetWork (ZFLen)
  1444.       IF ZErrCode <> 0 THEN _
  1445.          ZWasEL = 21480 : _
  1446.          GOTO 21900
  1447.       Sec = 255 AND (Sec + 1)
  1448.       GOTO 21490
  1449. '
  1450. ' *  ROUTINE TO WRITE OUT AN "Xmodem" OR "YMODEM" RECORD TO THE COMM. PORT
  1451. '
  1452. 21490 WasSO = WasSO + 1
  1453.       CALL PutCom (ZStartOfHeader$ + CHR$(Sec) + CHR$(Sec XOR 255))
  1454.       CALL PutCom (ZDnldRecord$)
  1455.       HaveACancel = ZFalse
  1456. 21503 WasWK$ = ZDnldRecord$
  1457. 21504 GOSUB 21750
  1458.       IF ZFileSysParm > 1 THEN _
  1459.          RETURN
  1460. 21510 IF ZCheckSum THEN _
  1461.          CALL PutCom(CHR$(XmodemChecksum)) _
  1462.       ELSE CALL PutCom(CHR$(CRCHigh) + CHR$(CRCLow))
  1463.       GOSUB 21280
  1464.       IF ZFileSysParm > 1 THEN _
  1465.          RETURN
  1466.       GOTO 21410
  1467. '
  1468. ' *  END-OF-FILE FOR Xmodem Dnlds -- SEND THE "EOT" CHARACTER AND WAIT UP
  1469. ' *  TO 2 SECONDS FOR A POSITIVE RESPONSE (I.E. AN "ACK").  IF NONE IS
  1470. ' *  RE-TRY UP TO 10 TIMES.  IF No POSITIVE RESPONSE IS RECEIVED AFTER TEN
  1471. ' *  Attempts, ASSUME THE DOWNLOAD WAS UNSUCCESSFULL.
  1472. '
  1473. 21530 CALL PutCom (ZEndTransmission$)
  1474.       WasX = 1
  1475. 21531 GOSUB 20810
  1476.       IF ZFileSysParm > 1 THEN _
  1477.          RETURN
  1478.       IF INSTR(ZWasY$,ZAcknowledge$) THEN _
  1479.          GOTO 21550
  1480.       CALL FindFKey
  1481.       IF ZSubParm < 0 THEN _
  1482.          ZFileSysParm = 2 : _
  1483.          RETURN
  1484.       IF ZKeyPressed$ = ZEscape$ THEN _
  1485.          GOSUB 21540 : _
  1486.          GOTO 21545
  1487.       IF WasX < 10 THEN _
  1488.          WasX = WasX + 1 : _
  1489.          GOTO 21531
  1490.       DnldCompleted = ZFalse
  1491.       GOTO 21230
  1492. 21540 GOSUB 20510
  1493.       IF ZFileSysParm > 1 THEN _
  1494.          RETURN
  1495.       RETURN
  1496. 21545 ZWasY$ = ZCancel$
  1497.       CALL PutCom (ZCancel$ + ZCancel$ + ZCancel$)
  1498.       DnldCompleted = ZFalse
  1499.       GOTO 21250
  1500. 21550 DnldCompleted = ZTrue
  1501.       GOTO 21250
  1502. 21560 DnldCompleted = ZFalse
  1503.       WasD$ = ZLineFeed$ + _
  1504.            "Caller aborted trans"
  1505.       GOSUB 21710
  1506.       IF ZFileSysParm > 1 THEN _
  1507.          RETURN
  1508.       GOTO 21545
  1509. '
  1510. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL OUTPUT ROUTINE
  1511. '
  1512. ' Modeled on lines 12975 to 12983 in RBBS-PC.BAS
  1513. 21630 ZSubParm = 1
  1514.       GOTO 21655
  1515. 21640 ZSubParm = 3
  1516.       GOTO 21655
  1517. 21650 ZSubParm = 5
  1518. 21655 CALL TPut
  1519.       IF ZSubParm < 0 THEN _
  1520.          ZFileSysParm = 2 : _
  1521.          RETURN
  1522.       IF ZSubParm = 8 THEN _
  1523.          GOSUB 21660
  1524.       RETURN
  1525. '
  1526. ' STANDARD ENTRY FOR RBBS-PC'S COMMON TERMINAL INPUT ROUTINE
  1527. '
  1528. ' Modeled on lines 12995 to 12997 in RBBS-PC.BAS
  1529. 21660 ZSubParm = 1
  1530.       CALL TGet
  1531. 21665 IF ZSubParm < 0 THEN _
  1532.          ZFileSysParm = 2
  1533.       RETURN
  1534. 21668 CALL PopCmdStack
  1535.       GOTO 21665
  1536. 21700 ZErrCode = 0
  1537.       ZLastIndex = 0
  1538.       RETURN
  1539. '
  1540. ' **** COMMON LOCAL DISPLAY PRINT ***
  1541. '
  1542. '  (formerly lines 1315 to 1320 in RBBS-PC.BAS
  1543. 21710 NumReturns = 1
  1544. 21720 CALL LPrnt (WasD$,NumReturns)
  1545.       RETURN
  1546. '
  1547. ' *  Xmodem / CRC INTERFACE
  1548. '
  1549. '  (formerly line 46000 in RBBS-PC.BAS
  1550. 21750 XmodemChecksum = 0
  1551.       CRCValue = 0
  1552.       CALL Xmodem(WasWK$,XmodemChecksum,CRCValue,CRCHigh,CRCLow)
  1553.       RETURN
  1554. '
  1555. ' * UPDATE DOWNLOAD STATISTICS
  1556. '
  1557. '  (formerly lines 50600 to 50614 in RBBS-PC.BAS
  1558. 21760 GOSUB 21780
  1559.       IF ZFileSysParm > 1 THEN _
  1560.          RETURN
  1561.       IF ZBatchTransfer THEN _
  1562.          CALL LinesInFile (ZNodeWorkFile$,ZDownFiles) _
  1563.       ELSE ZDownFiles = 1
  1564.       IF NOT DnldCompleted THEN _
  1565.          ZAutoLogoffReq = ZFalse : _
  1566.          ZWasDF$ = " Aborted" : _
  1567.          GOTO 21768
  1568.       CALL LogPDown (PersonalDnld,1+ZAnsIndex-FirstDnld)
  1569.       WasX = ((ZRatioRestrict# = 0) AND ZEnforceRatios)
  1570.       IF NOT WasX THEN _
  1571.          ZDnlds = ZDnlds + ZDownFiles : _
  1572.          ZGlobalDLToday! = ZGlobalDLToday! + ZDownFiles : _
  1573.          ZGlobalDnlds = ZGlobalDnlds + ZDownFiles : _
  1574.          ZDLBytes! = ZDLBytes! + ZNumDnldBytes! : _
  1575.          ZGlobalDLBytes! = ZGlobalDLBytes! + ZNumDnldBytes! : _
  1576.          ZDLToday! = ZDLToday! + ZDownFiles : _
  1577.          ZBytesToday! = ZBytesToday! + ZNumDnldBytes! : _
  1578.          ZGlobalBytesToday! = ZGlobalBytesToday! + ZNumDnldBytes!
  1579.       ZNumDnldBytes! = 0
  1580.       CALL Muzak (6)
  1581.       ZWasDF$ = " Downloaded"
  1582.       IF (ZAnsIndex = LastDnld OR NOT ZConcatFIles) THEN _
  1583.          CALL SkipLine (1) : _
  1584.          CALL QuickTPut1 ("Download successful") : _
  1585.          IF WasX THEN _
  1586.             CALL QuickTPut1 ("but not counted against ratios")
  1587. 21768 IF ZAutoDownInProgress THEN _
  1588.          ZWasDF$ = " AUTO" + _
  1589.               MID$(ZWasN$,2)
  1590.       IF INSTR(ZWasN$,"Aborted") THEN _
  1591.          ZAutoDownInProgress = 0
  1592.       ZOutTxt$ = ""
  1593. 21770 CALL AMorPM
  1594.       IF NOT ZBatchTransfer THEN _
  1595.          GOTO 21773
  1596.       CALL OpenWork (2,ZNodeWorkFile$)
  1597.       IF ZErrCode > 0 THEN _
  1598.          RETURN
  1599.       ZWasQ = 0
  1600.       WHILE NOT EOF(2)
  1601.          CALL ReadAny
  1602.          ZWasQ = ZWasQ + 1
  1603.          ZUserIn$(ZWasQ) = ZOutTxt$
  1604.       WEND
  1605. 21772 IF ZWasQ < 1 THEN _
  1606.          ZBatchTransfer = ZFalse : _
  1607.          RETURN
  1608.       CALL OpenWork (2,ZUserIn$(ZWasQ))
  1609.       IF ZErrCode > 0 THEN _
  1610.          ZErrCode = 0 : _
  1611.          ZWasQ = ZWasQ - 1 : _
  1612.          GOTO 21772
  1613.       ZBytesInFile# = LOF(2)
  1614.       ZFileName$ = ZUserIn$(ZWasQ)
  1615. 21773 CALL BreakFileName (ZFileName$,DR$,WasX$,Extension$,ZTrue)
  1616.       ZWasZ$ = WasX$ + _
  1617.            Extension$ + _
  1618.            ZWasDF$ + _
  1619.            " at " + _
  1620.            ZTime$ + _
  1621.            " using " + _
  1622.            ZWasFT$ + _
  1623.            STR$(ZBytesInFile#)
  1624.       CALL UpdtCalr (ZWasZ$,2)
  1625.       IF ZBatchTransfer THEN _
  1626.          ZWasQ = ZWasQ - 1 : _
  1627.          GOTO 21772
  1628.       'CALL CheckRatio (ZFalse)
  1629. 21774 IF ZMenuIndex = 6 THEN _
  1630.          IF DnldCompleted THEN _
  1631.             ZOutTxt$ = WasX$ : _
  1632.             ZSubParm = 5 : _
  1633.             CALL Library
  1634.       RETURN
  1635. '
  1636. ' *****   TURN ON INTERMEDIATE ECHO   ****
  1637. '
  1638. '  (formerly line 50620 in RBBS-PC.BAS
  1639. 21780 IF ZEchoer$ = "I" THEN _
  1640.          CALL SetEcho ("I")
  1641. '
  1642. ' *  RESTORE COMMUNICATIONS AFTER Switch TO 8 BIT
  1643. '
  1644. '  (formerly between lines 50620 and 50630 in RBBS-PC.BAS
  1645.       IF SwitchToEight THEN _
  1646.          IF ZSwitchBack THEN _
  1647.             OUT ZLineCntlReg, PrevLineCntl : _
  1648.             CALL DelayTime (3) : _
  1649.             ZEightBit = ZFalse : _
  1650.             SwitchToEight = ZFalse
  1651.       RETURN
  1652. '
  1653. ' *****  TURN OFF INTERMEDIATE ECHO  ****
  1654. '
  1655. '  (formerly line 50630 in RBBS-PC.BAS
  1656. 21790 IF ZEchoer$ = "I" THEN _
  1657.          CALL SetEcho ("R")
  1658.       RETURN
  1659. '
  1660. ' *****   DIRECTORY SEARCH   ****
  1661. '
  1662. '  (formerly lines 52900 to 52920 in RBBS-PC.BAS
  1663. 21800 WasCK = 2
  1664. 21810 ZOutTxt$ = "Search string or filename (wildcards OK), [ENTER] quits)"  ' DA071701
  1665.       ZMacroMin = 99
  1666.       GOSUB 21668
  1667.       IF ZWasQ = 0 THEN _
  1668.          RETURN
  1669. 21820 WasRS$ = ZUserIn$(ZAnsIndex)
  1670.       WildSearch = (INSTR(WasRS$,"*") > 0 OR INSTR(WasRS$,"?") > 0)
  1671.       CALL AllCaps (WasRS$)
  1672.       IF RIGHT$(WasRS$,1) = "*" THEN _                               ' KG081201
  1673.          IF RIGHT$(WasRS$,2) <> ".*" THEN _                          ' KG081201
  1674.             WasRS$ = WasRS$ + ".*"                                   ' KG081201
  1675.       SearchString$ = WasRS$
  1676.       SearchDate$ = ""
  1677.       ZJumpSearching = ZFalse
  1678.       WasA1$ = WasRS$
  1679.       GOTO 21867
  1680. '
  1681. ' *****  P - personal download  ****
  1682. '
  1683. '  (formerly lines 52950 to 52952 in RBBS-PC.BAS
  1684. 21850 IF ZPersonalBegin < 1 OR ZPersonalLen < 1 THEN _
  1685.          RETURN
  1686.       DnldFlag = 0
  1687.       PersonalDnld = ZTrue
  1688. 21852 CALL PersFile (MID$(ZUserRecord$,ZPersonalBegin,ZPersonalLen),_
  1689.                      DnldFlag)
  1690.       IF ZSubParm = -1 THEN _
  1691.          ZFileSysParm = 7: _
  1692.          RETURN
  1693.       IF ZLastIndex <= 0 THEN _
  1694.          GOTO 21854
  1695.       ZConcatFIles = ZPersonalConcat
  1696.       ZStopInterrupts = ZTrue
  1697.       TimeLockExempt = ZTrue
  1698.       GOSUB 20202
  1699.       IF ZFileSysParm > 1 THEN _
  1700.          GOTO 21854
  1701.       TimeLockExempt = ZFalse
  1702.       ZConcatFIles = ZFalse
  1703.       GOTO 21852
  1704. 21854 PersonalDnld = ZFalse
  1705.       RETURN
  1706. '
  1707. ' *  WasN - COMMAND FROM FILES MENU (DISPLAY NEW FILES SINCE Last DIR DISPLAY)
  1708. '
  1709. '  (formerly lines 53000 to 53070 in RBBS-PC.BAS
  1710. 21860 WasCK = 1
  1711. 21862 WasA1$ = RIGHT$(ZWasLM$,4) +_
  1712.             LEFT$(ZWasLM$,2)
  1713.       ZOutTxt$ = "Files on/after MMDDYY, [ENTER] = " + WasA1$
  1714.       GOSUB 21668
  1715.       CALL AllCaps (ZUserIn$(ZAnsIndex))
  1716.       IF ZWasQ = 0 OR ZUserIn$(ZAnsIndex) = "S" THEN _
  1717.          WasRS$ = ZWasLM$ : _
  1718.          GOTO 21866
  1719. 21865 IF LEN(ZUserIn$(ZAnsIndex)) <> 6 THEN _
  1720.          GOTO 21862
  1721.       WasA1$ = ZUserIn$(ZAnsIndex)
  1722.       WasRS$ = RIGHT$(WasA1$,2) + _
  1723.             LEFT$(WasA1$,4)
  1724.       ListNew = ZTrue
  1725. 21866 SearchDate$ = WasRS$
  1726.       SearchString$ = ""
  1727.       ZJumpSearching = ZFalse
  1728. 21867 CALL GetDirs (NOT ZExpertUser)
  1729.       IF ZWasQ = 0 THEN _
  1730.          RETURN
  1731. 21871 CALL ConvertDir (ZAnsIndex)
  1732.       ZListDir = ZTrue
  1733.       ListNew = ZTrue
  1734.       ZSearchingAll = ZFalse
  1735. 21875 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1736.       IF NOT ZSearchingAll THEN _
  1737.          IF ZWasZ$ = "ALL" THEN _
  1738.             IF NOT ZLimitSearchToFMS THEN _
  1739.                GOSUB 21890
  1740. 21880 WasQX = ZAnsIndex
  1741.       GOSUB 20157
  1742.       IF ZFileSysParm > 1 THEN _
  1743.          RETURN
  1744.       ZAnsIndex = ZAnsIndex + 1
  1745.       IF ZAnsIndex <= ZLastIndex THEN _
  1746.          GOTO 21875
  1747.       ListNew = ZFalse
  1748.       SearchString$ = ""
  1749.       SearchDate$ = ""
  1750.       RETURN
  1751. 21890 WasG = ZAnsIndex
  1752.       CALL GetAll (ZUserIn$(),WasG)
  1753.       ZSearchingAll = ZTrue
  1754.       ZLastIndex = WasG
  1755.       ZAnsIndex = ZAnsIndex + 1
  1756.       RETURN
  1757. '
  1758. ' *  MAIN FILE SYSTEM ERROR TRAP - ALL ERRORS PASS THROUGH THIS ROUTINE
  1759. '
  1760. '  (formerly lines 13000 to 13500 in RBBS-PC.BAS
  1761. 21900 IF ZDebug THEN _
  1762.          ZOutTxt$ = "RBBSSUB5 DEBUG Error Trap Entry ERL=" + _
  1763.               STR$(ZWasEL) + _
  1764.               " ERR=" + _
  1765.               STR$(ZErrCode) : _
  1766.          IF ZPrinter THEN _
  1767.             CALL Printit(ZOutTxt$) _
  1768.          ELSE CALL LPrnt(ZOutTxt$,1)
  1769.       IF ZWasEL = 20126 AND ZErrCode = 53 THEN _
  1770.          GOTO 20142
  1771.       IF ZWasEL = 20242 AND ZErrCode = 62 THEN _
  1772.          CALL UpdtCalr (ZFileSecFile$ + " bad format!",2) : _
  1773.          GOTO 20247
  1774.       IF ZWasEL = 20263 THEN _
  1775.          ZOutTxt$ = "<Download aborted>" : _
  1776.          DnldCompleted = ZFalse : _
  1777.          GOTO 20390                                                  ' ML080601
  1778.       IF ZWasEL = 20560 AND ZErrCode = 67 THEN _
  1779.          GOTO 20451
  1780.       IF ZWasEL = 20560 AND ZErrCode = 70 THEN _
  1781.          IF VAL(ZFreeSpace$) > 1999 THEN _
  1782.             GOTO 20610 _
  1783.          ELSE CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1784.               GOTO 21700
  1785.       IF ZWasEL = 20620 THEN _
  1786.          GOTO 20670
  1787.       IF ZWasEL = 20650 THEN _
  1788.          GOTO 20670
  1789.       IF ZWasEL = 20736 AND ZErrCode = 53 THEN _
  1790.          GOTO 21700
  1791.       IF ZWasEL = 20900 AND ZErrCode = 75 THEN _
  1792.          GOTO 21230
  1793.       IF ZWasEL = 20900 AND ZErrCode = 70 THEN _
  1794.          CALL QuickTPut1 ("No room for uploads. Try tomorrow.") : _
  1795.          GOTO 21230
  1796.       IF ZWasEL = 21131 OR ZWasEL = 21220 THEN _
  1797.          ZErrCode = 0 : _
  1798.          GOTO 21230
  1799.       IF ZWasEL = 21480 THEN _
  1800.          CALL LogError : _
  1801.          IF ZErrCode = 57 THEN _
  1802.             CALL QuickTPut1 ("Error reading file.  Aborting download") : _
  1803.             DnldCompleted = ZFalse : _
  1804.             GOTO 21230
  1805. 21910 CALL LogError
  1806.       CALL QuickTPut1 (ZCallersRecord$)
  1807.       ZFileSysParm = 3
  1808.       RETURN
  1809. 21920 ' EXIT RBBS-PC FILE SUBSYSTEM
  1810.       END SUB
  1811. 63100 ' $SUBTITLE: 'DoorReturn - Subroutine to process requests from a door'
  1812. ' $PAGE
  1813. '
  1814. '  NAME    -- DoorReturn
  1815. '
  1816. '  INPUTS  -- PARAMETER                      MEANING
  1817. '             DOUTx.DEF               File of requests
  1818. '
  1819. '  OUTPUTS -- ZUserSecLevel     Revised Security Level
  1820. '
  1821. '  PURPOSE -- To give Doors a stable way to make requests
  1822. '             to the host.
  1823. '
  1824.       SUB DoorReturn STATIC
  1825.       IF ZPrivateDoor OR NOT ZExitToDoors THEN _
  1826.          EXIT SUB
  1827.       ZFileName$ = "DOUT" + ZNodeID$ + ".DEF"
  1828.       CALL FindIt (ZFileName$)
  1829.       IF NOT ZOK THEN _
  1830.          EXIT SUB
  1831. 63105 IF EOF(2) THEN _
  1832.          GOTO 63195
  1833.       CALL ReadParms (ZOutTxt$(),2,1)
  1834.       IF ZErrCode > 0 THEN _
  1835.          GOTO 63115
  1836.       IF LEN(ZOutTxt$(1)) < 2 THEN _
  1837.          EXIT SUB
  1838.       ZUserIn$ = LEFT$(ZOutTxt$(1),2) + ","
  1839.       WasX = INSTR("SL,UR,",ZUserIn$)
  1840.       IF WasX = 0 THEN _
  1841.          GOTO 63105
  1842.       WasX = WasX\3 + 1
  1843.       ON WasX GOTO 63110,63115
  1844.       GOTO 63105
  1845. 63110 WasX$ = LEFT$(ZOutTxt$(2),1)         ' ZWasSL = Security Level
  1846.       CALL CheckInt (ZOutTxt$(2))
  1847.       IF ZErrCode > 0 THEN _
  1848.          GOTO 63105
  1849.       IF WasX$ = "+" OR WasX$ = "-" THEN _
  1850.          ZWasA = ZUserSecLevel + ZTestedIntValue _
  1851.       ELSE ZWasA = ZTestedIntValue
  1852.       IF ZWasA < ZSysopSecLevel THEN _
  1853.          ZAdjustedSecurity = (ZWasA <> ZUserSecLevel) : _
  1854.          IF ZAdjustedSecurity THEN _
  1855.             ZUserSecLevel = ZWasA : _
  1856.             MID$(ZUserRecord$,47,2) = MKI$(ZWasA) : _
  1857.             CALL QuickTPut1 ("Security changed to" + STR$(ZWasA)) : _
  1858.             CALL UpdtCalr ("Door reset security to "+STR$(ZWasA),2)
  1859.       GOTO 63105
  1860. 63115 IF LEN(ZOutTxt$(1)) < 7 THEN _
  1861.          GOTO 63105
  1862.       IF MID$(ZOutTxt$(1),3,1) <> "(" THEN _
  1863.          GOTO 63105
  1864.       WasX = INSTR(4,ZOutTxt$(1),":")
  1865.       IF WasX < 1 THEN _
  1866.          GOTO 63105
  1867.       CALL CheckInt (MID$(ZOutTxt$(1),4,WasX-4))
  1868.       IF ZErrCode > 0 THEN _
  1869.          GOTO 63105
  1870.       IF ZTestedIntValue > 128 OR ZTestedIntValue < 1 THEN _
  1871.          GOTO 63105
  1872.       ZWasA = ZTestedIntValue
  1873.       CALL CheckInt (MID$(ZOutTxt$(1),WasX+1))
  1874.       IF ZErrCode > 0 OR ZTestedIntValue < 1 OR ZTestedIntValue > 128 THEN _
  1875.          GOTO 63105
  1876.       MID$(ZUserRecord$,ZWasA,ZTestedIntValue) = LEFT$(ZOutTxt$(2) + _
  1877.          SPACE$(ZTestedIntValue),ZTestedIntValue)
  1878.       CALL UpdtCalr ("Door set UR"+STR$(ZWasA)+":"+STR$(ZTestedIntValue)+" to <"+ZOutTxt$(2)+">",2)
  1879.       GOTO 63105
  1880. 63195 CALL KillWork (ZFileName$)
  1881.       ZErrCode = 0
  1882.       END SUB
  1883. 63200 ' $SUBTITLE: 'WildCard -- Matches string to a pattern'
  1884. ' $PAGE
  1885. '  NAME    -- WildCard
  1886. '
  1887. '  INPUTS  -- PARAMETER             MEANING
  1888. '             Pattern$           PATTERN TO CHECK
  1889. '             Strng$             STRING TO FIE
  1890. '
  1891. '  OUTPUTS -- ZOK                True IF MATCH Found
  1892. '                                False IF No MATCH WAS Found
  1893. '
  1894. '  PURPOSE  Determine whether a string is an instance in a pattern
  1895. '           supported patterns are only "?" which requires a
  1896. '           character but can be any, and "*" which matches any-
  1897. '           thing, including a null string.  Anything else in a
  1898. '           sting must be an exact match.  Supports reverse
  1899. '           wildcards.
  1900. '
  1901. '
  1902.       SUB WildCard (Pattern$,Strng$) STATIC
  1903. 63285 ZOK = ZTrue
  1904.       PatPos = 0
  1905.       StrPos = 0
  1906.       Inc = 1
  1907.       WasKT = 0
  1908.       WasP = LEN(Pattern$)
  1909.       WasL = LEN(Strng$)
  1910. 63286 PatPos = PatPos + Inc
  1911.       StrPos = StrPos + Inc
  1912.       WasKT = WasKT + 1
  1913.       IF WasKT > WasL THEN _
  1914.          GOTO 63288
  1915.       ZUserIn$ = MID$(Pattern$,PatPos,1)
  1916.       IF ZUserIn$ = "*" THEN _
  1917.          GOTO 63289
  1918. 63287 IF ZUserIn$ <> "?" AND MID$(Strng$,StrPos,1) <> ZUserIn$ THEN _
  1919.          ZOK = ZFalse : _
  1920.          EXIT SUB
  1921.       GOTO 63286
  1922. 63288 IF PatPos >= LEN(Pattern$) OR PatPos < 1 THEN _
  1923.          EXIT SUB
  1924.       IF MID$(Pattern$,PatPos,1) <> "*" THEN _
  1925.          ZOK = ZFalse : _
  1926.          EXIT SUB
  1927. 63289 IF PatPos <> WasP THEN _   ' Reverse search
  1928.          Inc = -1 : _
  1929.          WasP = PatPos : _
  1930.          PatPos = LEN(Pattern$) + 1 : _
  1931.          StrPos = LEN(Strng$) + 1 : _
  1932.          WasKT = 0 : _
  1933.          GOTO 63286
  1934.       END SUB
  1935. 63300 ' $SUBTITLE: 'BreakFileName - sub to split file name into components'
  1936. ' $PAGE
  1937. '
  1938. '  NAME    -- BreakFileName
  1939. '
  1940. '  INPUTS  -- PARAMETER                    MEANING
  1941. '             FileSpec$        FULL NAME OF FILE
  1942. '             ForJoining       True IF WANT PARTS FORMATTED FOR
  1943. '                                           FORMING FILE NAMES
  1944. '  OUTPUTS -- DrvPath$         DRIVE AND PATH
  1945. '             Prefix$          PREFIX OF FILE NAME
  1946. '             Extension$       EXTENSION OF FILE NAME
  1947. '
  1948. ' (E.G. "C:\RBBS\ARCE.COM" HAS "C:\RBBS" AS DRIVE AND PATH,
  1949. '                              "ARCE"    AS PREFIX OF THE FILE NAME, AND
  1950. '                              "COM"     AS THE EXTENSION OF THE FILE NAME.
  1951. '
  1952. ' JOINED FORMAT IS C:\RBBS\,ARCE,.COM
  1953. '
  1954. '  PURPOSE -- To break a file name into its component parts
  1955. '             of drive/path, prefix, and extension
  1956. '
  1957. '
  1958.       SUB BreakFileName (PassedFileSpec$,DrvPath$,Prefix$,Extension$,ForJoining) STATIC ' KG081705
  1959.       FileSpec$ = PassedFileSpec$                                    ' KG081705
  1960.       CALL AllCaps (FileSpec$)
  1961.       DrvPath$ = ""
  1962.       Prefix$ = ""
  1963.       Extension$ = ""                                                ' KG082301
  1964.       WasL = LEN(FileSpec$)
  1965.       IF WasL < 1 THEN _
  1966.          EXIT SUB
  1967.       CALL FindLast (FileSpec$,"\",WasX,WasY)
  1968.       IF WasX < 1 THEN _
  1969.          IF MID$(FileSpec$,2,1) = ":" THEN _
  1970.             DrvPath$ = LEFT$(FileSpec$,2) : _                        ' DA082101
  1971.             ZWasS = 3 _
  1972.          ELSE ZWasS = 1 _
  1973.       ELSE DrvPath$ = LEFT$(FileSpec$,WasX) : _                      ' DA082101
  1974.            ZWasS = WasX + 1                                          ' DA082101
  1975.       WasX = INSTR(ZWasS,FileSpec$ + ".",".")                        ' EC061301
  1976.       IF WasX < WasL THEN _
  1977.          Extension$ = MID$(FileSpec$,WasX)                           ' DA082101
  1978.       IF ZWasS <= WasL THEN _
  1979.          IF WasX >= ZWasS THEN _
  1980.             Prefix$ = MID$(FileSpec$,ZWasS,WasX - ZWasS)
  1981.       IF ForJoining THEN _                                           ' DA082101
  1982.          EXIT SUB
  1983.       IF WasY > 1 THEN _                                             ' KG082301
  1984.          DrvPath$ = LEFT$(DrvPath$, LEN(DrvPath$) - 1)               ' DA082101
  1985.       IF LEN(Extension$) > 0 THEN _
  1986.          Extension$ = MID$(Extension$, 2)                            ' DA082101
  1987.       END SUB
  1988. 63310 ' $SUBTITLE: 'RestoreCom - sub to restore comm port'
  1989. ' $PAGE
  1990. '
  1991. '  NAME    -- RestoreCom
  1992. '
  1993. '  INPUTS  -- none
  1994. '
  1995. '  OUTPUTS -- none
  1996. '
  1997. '  PURPOSE -- To restore communications port after an external
  1998. '             program may have left it in altered state
  1999. '
  2000.       SUB RestoreCom STATIC
  2001.       Parity$ = MID$(",N,8,1,E,7,1",7 + 6 * ZEightBit,6)
  2002.       IF ZLocalUser THEN _
  2003.          EXIT SUB
  2004.       CALL SetBaud
  2005.       IF NOT ZFossil THEN _
  2006.          CALL OpenCom(ZTalkToModemAt$,Parity$)
  2007.       END SUB
  2008. 63320 ' $SUBTITLE: 'ShellExit - sub to shell out from RBBS'
  2009. ' $PAGE
  2010. '
  2011. '  NAME    -- ShellExit
  2012. '
  2013. '  INPUTS  -- ShellTem$     String to invoke shell with
  2014. '
  2015. '  OUTPUTS -- none
  2016. '
  2017. '  PURPOSE -- Delay so that strings can finish printing.  Restore comm
  2018. '             port on return
  2019. '
  2020.       SUB ShellExit (ShellTem$) STATIC
  2021.       CALL DelayTime (8 + ZBPS)
  2022.       IF NOT ZLocalUser THEN _
  2023.          IF ZFossil THEN _
  2024.             CALL FOSExit(ZComPort) _
  2025.          ELSE CLOSE 3 : _
  2026.               OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  2027.       CLOSE 2
  2028.       CALL MetaGSR (ShellTem$,ZFalse)
  2029.       SHELL ShellTem$
  2030.       IF ZFossil THEN _
  2031.          IF NOT ZLocalUser THEN _
  2032.             CALL FOSinit(ZComPort,Result) : _
  2033.             IF Result = -1 THEN _
  2034.                CALL PScrn("ERROR INIT FOSSIL AFT EXTERNAL") : _      ' KG072701
  2035.                SYSTEM
  2036.       CALL DelayTime (2)
  2037.       CALL RestoreCom
  2038.       END SUB
  2039. 63330 ' $SUBTITLE: 'ReadMacro - sub to read macro'
  2040. ' $PAGE
  2041. '
  2042. '  NAME    -- ReadMacro
  2043. '
  2044. '  INPUTS  -- PARAMETER             MEANING
  2045. '
  2046. '  OUTPUTS -- ZOutTxt$               LINE TO PROCESS IN MACRO
  2047. '             ZMacroActive           FLAG WHETHER IN A MACRO
  2048. '
  2049. '  PURPOSE -- Reads in a line from macro file (#6) and processes
  2050. '             macro commands, which are:
  2051. '             *0 - display what follows, no carriage return
  2052. '             *1 - display what follows with carriage return
  2053. '             *B - display block that follows
  2054. '             *F - display File
  2055. '             WT - wait specified # of seconds
  2056. '             >> - append following block to specified file
  2057. '             ST - stack following (with carriage return)
  2058. '             ON - define case
  2059. '             == - case value that applies to following block
  2060. '             M! - execute following macro
  2061. '             M@ - abort macro processing
  2062. '             EY - Echo on (yes)
  2063. '             EN - Echo off (no)
  2064. '             /* - comment line skipped in processing
  2065. '             TK - Turbo key on (if user preference)
  2066. '             << - Read from file into a form
  2067. '             := - Assign value to work variable
  2068. '             LO - Set the location of a file                        ' KG022301
  2069. '
  2070.       SUB ReadMacro STATIC
  2071.       IF ZMacroTemplate$ <> "" THEN _
  2072.          GOTO 63392
  2073.       IF ZDistantTGet = 2 THEN _
  2074.          GOTO 63349
  2075. 63336 GOSUB 63395
  2076.       IF NOT ZMacroActive THEN _
  2077.          ZMacroEcho = ZTrue : _
  2078.          EXIT SUB                                                    ' KG042501
  2079.       IF CompareVar > 0 THEN _
  2080.          IF NOT CaseExecute THEN _
  2081.             IF LEFT$(ZOutTxt$,3) = ZSmartTextCode$+"==" THEN _
  2082.                WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3) : _          ' KG042501
  2083.                GOTO 63370 _
  2084.             ELSE IF LEFT$(ZOutTxt$,7) = ZSmartTextCode$ + "END ON" THEN _
  2085.                     CompareVar = 0 : _
  2086.                     GOTO 63336 _
  2087.                   ELSE GOTO 63336
  2088.       IF LEN(ZOutTxt$) < 3 THEN _                                    ' KG042501
  2089.          GOTO 63398                                                  ' KG042501
  2090.       WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-3)                       ' KG042501
  2091.       IF LEFT$(ZOutTxt$,1) <> ZSmartTextCode$ THEN _
  2092.          GOTO 63398
  2093.       CALL CheckInt (MID$(ZOutTxt$,2))
  2094.       IF ZErrCode > 0 THEN _
  2095.          GOTO 63398
  2096.       IF ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2097.          ZOutTxt$ = WasX$ : _  ' Macro command ask
  2098.          ZForceKeyboard = ZTrue : _
  2099.          ZMacroSave = ZTestedIntValue : _
  2100.          ZLinesPrinted = 1 : _
  2101.          ZNonStop = (ZPageLength < 1) : _
  2102.          EXIT SUB
  2103.       ON (1+INSTR("*0*1*B*FWT>>STON==M!M@EYEN/*TK<<:=LVNVCVLO",MID$(ZOutTxt$,2,2)))\2 GOTO _ ' KG022301
  2104.          63345, _  ' Display with no Carriage Return
  2105.          63347, _  ' Display with Carriage Return
  2106.          63340, _  ' Display Block
  2107.          63348, _  ' Display File
  2108.          63343, _  ' Wait # of seconds
  2109.          63350, _  ' Append to file
  2110.          63355, _  ' Stack
  2111.          63360, _  ' Case
  2112.          63370, _  ' Case Comparison
  2113.          63375, _  ' Macro execute
  2114.          63380, _  ' Macro Abort
  2115.          63383, _  ' Macro Echo on
  2116.          63385, _  ' Macro Echo off
  2117.          63336, _  ' Macro Comment
  2118.          63387, _  ' Turbo Key allowed
  2119.          63390, _  ' Form read
  2120.          63362, _  ' Assign value to work var
  2121.          63363, _  ' LV list verify
  2122.          63364, _  ' NV number verify
  2123.          63364, _  ' CV character verify                             ' KG022301
  2124.          63367     ' LO assign file location                         ' KG022301
  2125.       GOTO 63398
  2126. 63338 ZOutTxt$ = WasX$
  2127. 63339 ZSubParm = 4
  2128.       CALL TPut
  2129.       RETURN
  2130. 63340 WasX$ = ZSmartTextCode$ + "END"  ' Print Block
  2131.       GOSUB 63395
  2132.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2133.          GOSUB 63339
  2134.          CALL SkipLine (1)
  2135.          GOSUB 63395
  2136.       WEND
  2137.       GOTO 63336
  2138. 63343 CALL CheckInt (WasX$)      ' Delay
  2139.       IF ZErrCode = 0 THEN _
  2140.          CALL DelayTime (ZTestedIntValue)
  2141.       GOTO 63336
  2142. 63345 GOSUB 63338               ' Print Line
  2143.       GOTO 63336
  2144. 63347 GOSUB 63338
  2145.       CALL SkipLine (1)
  2146.       GOTO 63336
  2147. 63348 CALL Trim (WasX$)            ' Print File
  2148.       CALL FINDITX (WasX$,7)
  2149.       IF NOT ZOK THEN _
  2150.          GOTO 63336
  2151.       ZLinesPrinted = 1
  2152.       ZNo = ZFalse
  2153.       ZNonStop = (ZNonStop OR ZPageLength < 1)
  2154. 63349 WHILE (NOT EOF(7) AND (NOT ZNo) AND (ZNonStop OR (ZLinesPrinted < ZPageLength)) AND (ZSubParm > -1))
  2155.          CALL ReadDir (7,1)
  2156.          GOSUB 63396
  2157.          ZSubParm = 5
  2158.          CALL TPut
  2159.       WEND
  2160.       ZDistantTGet = 0
  2161.       IF ZSubParm < 0 THEN _
  2162.          EXIT SUB
  2163.       IF EOF(7) OR ZNo THEN _
  2164.          CLOSE 7 : _
  2165.          ZNo = ZFalse : _
  2166.          GOTO 63336
  2167.       ZDistantTGet = 2
  2168.       CALL PauseExit
  2169.       EXIT SUB
  2170. 63350 ZWasEN$ = WasX$            ' Append to file
  2171.       WasX = INSTR(ZWasEN$," /FL")
  2172.       OverStrike = (WasX > 0)
  2173.       IF OverStrike THEN _
  2174.          ZWasEN$ = LEFT$(ZWasEN$,WasX-1) + RIGHT$(ZWasEN$,LEN(ZWasEN$)-WasX-3)
  2175.       CALL Trim (ZWasEN$)
  2176.       CALL LockAppend
  2177.       IF ZErrCode > 0 THEN _
  2178.          GOTO 63352
  2179.       GOSUB 63395
  2180.       WasX$ = ZSmartTextCode$ + "END"
  2181.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2182.          CALL PrintWorkA (ZOutTxt$)
  2183.          GOSUB 63395
  2184.       WEND
  2185. 63352 CALL UnLockAppend
  2186.       OverStrike = ZFalse
  2187.       GOTO 63336
  2188. 63355 ZCommPortStack$ = ZCommPortStack$ + WasX$ + ZCarriageReturn$  ' STack
  2189.       GOTO 63336
  2190. 63360 CompareVar = VAL(WasX$)
  2191.       CALL AllCaps (WasX$)
  2192.       IF CompareVar < 1 OR CompareVar > ZMaxWorkVar THEN _
  2193.          CompareVar = 0
  2194.       GOTO 63336
  2195. 63362 CALL Trim (WasX$)                                              ' KG021803
  2196.       CALL CheckInt (WasX$)
  2197.       WasX = INSTR(WasX$," ")
  2198.       IF WasX > 0 AND ZTestedIntValue > 0 AND ZTestedIntValue <= ZMaxWorkVar THEN _
  2199.          ZGSRAra$(ZTestedIntValue) = RIGHT$(WasX$,LEN(WasX$)-WasX)   ' KG021803
  2200.       GOTO 63336
  2201. 63363 ZVerifyList$ = WasX$
  2202.       CALL Trim (ZVerifyList$)
  2203.       GOTO 63365
  2204. 63364 CALL Trim (WasX$)
  2205.       WasX = INSTR(WasX$," ")
  2206.       IF WasX = 0 THEN _
  2207.          GOTO 63336
  2208.       ZVerifyLow$ = LEFT$(WasX$,WasX-1)
  2209.       ZVerifyHigh$ = RIGHT$(WasX$,LEN(WasX$)-WasX)
  2210.       CALL Trim (ZVerifyLow$)
  2211.       CALL Trim (ZVerifyHigh$)
  2212.       ZVerifyNumeric = (MID$(ZOutTxt$,2,1) = "N")
  2213. 63365 ZVerifying = ZTrue
  2214.       GOTO 63336
  2215. 63367 CALL TRIM (WasX$)                                              ' KG022301
  2216.       ZFileLocation$ = WasX$                                         ' KG022301
  2217.       GOTO 63336                                                     ' KG022301
  2218. 63370 IF CompareVar = 0 THEN _     ' Compare Case
  2219.          GOTO 63336
  2220.       ZWasDF$ = ZGSRAra$(CompareVar)
  2221.       CALL AllCaps (ZWasDF$)
  2222.       CaseExecute = (WasX$ = ZWasDF$)
  2223.       GOTO 63336
  2224. 63375 CALL Trim (WasX$)           ' Execute Macro
  2225.       CALL Macro (WasX$,WasX)
  2226.       GOTO 63336
  2227. 63380 ZMacroActive = ZFalse     ' Abort Macro
  2228.       GOTO 63398
  2229. 63383 ZMacroEcho = ZTrue
  2230.       GOTO 63336
  2231. 63385 ZMacroEcho = ZFalse
  2232.       GOTO 63336
  2233. 63387 ZTurboKey = -ZTurboKeyUser   'TK Turbo Key
  2234.       GOTO 63336
  2235. 63390 ZUserIn$ = ZOutTxt$
  2236.       ZUserIn$(5) = ""
  2237.       ZUserIn$(6) = ""
  2238.       ZWasQ = 1
  2239.       ZStoreParseAt = 1
  2240.       CALL ParseIt
  2241.       IF ZWasQ < 4 THEN _
  2242.          GOTO 63336
  2243.       WasX$ = ZSmartTextCode$ + "END"
  2244.       GOSUB 63397
  2245.       ZMacroTemplate$ = ""
  2246.       WHILE ZMacroActive AND LEFT$(ZOutTxt$,4) <> WasX$
  2247.          ZMacroTemplate$ = ZMacroTemplate$ + ZOutTxt$ + ZCrLf$
  2248.          GOSUB 63397
  2249.       WEND
  2250.       WasX = VAL(ZUserIn$(4))
  2251.       VarLen = (ZUserIn$(3) <> "/F")
  2252.       CALL FindIt (ZUserIn$(2))
  2253.       IF (WasX < 1) OR (NOT ZOK) OR (VarLen AND WasX > ZMaxWorkVar) THEN _
  2254.          ZMacroTemplate$ = "" : _
  2255.          GOTO 63336
  2256.       PauseEachRec = (ZUserIn$(6) = "/1")
  2257. 63392 CALL FormRead (ZMacroTemplate$,ZUserIn$(2),NOT VarLen,WasX,(ZUserIn$(5) = "/FL"),PauseEachRec)
  2258.       IF ZMacroTemplate$ <> "" THEN _
  2259.          EXIT SUB _
  2260.       ELSE GOTO 63336
  2261. 63395 GOSUB 63397
  2262.       GOSUB 63396
  2263.       RETURN
  2264. 63396 CALL SmartText (ZOutTxt$,ZFalse, OverStrike)
  2265.       CALL MetaGSR (ZOutTxt$,OverStrike)
  2266.       RETURN
  2267. 63397 IF EOF(6) THEN _         ' Read next line in macro
  2268.          ZMacroActive = ZFalse _
  2269.       ELSE CALL ReadDir (6,1) : _
  2270.            ZMacroActive = (ZErrCode = 0)
  2271.       RETURN
  2272. 63398 END SUB    ' Not Macro command - pass to normal processing
  2273. 63400 ' $SUBTITLE: 'LockAppend - prepares for file append'
  2274. ' $PAGE
  2275. '
  2276. '  NAME    -- LockAppend
  2277. '
  2278. '  INPUTS  -- ZWasEN$            Name of file to append to
  2279. '
  2280. '  OUTPUTS -- none
  2281. '
  2282. '  PURPOSE -- Locks and opens file to append to
  2283. '
  2284.       SUB LockAppend STATIC
  2285.       WasBX = &H4
  2286.       ZSubParm = 9
  2287.       CALL FileLock
  2288.       ZErrCode = 0
  2289.       CALL OpenWorkA (ZWasEN$)
  2290.       END SUB
  2291. 63410 ' $SUBTITLE: 'UnLockAppend - cleans up after file append'
  2292. ' $PAGE
  2293. '
  2294. '  NAME    -- UnLockAppend
  2295. '
  2296. '  INPUTS  -- none
  2297. '
  2298. '  OUTPUTS -- none
  2299. '
  2300. '  PURPOSE -- Unlocks and close file appending to
  2301. '
  2302.       SUB UnLockAppend STATIC
  2303.       WasBX = &H4
  2304.       ZSubParm = 10
  2305.       CALL FileLock
  2306.       CLOSE 2
  2307.       END SUB
  2308. 63420 ' $SUBTITLE: 'FormRead - Reads from a file into a form'
  2309. ' $PAGE
  2310. '
  2311. '  NAME    -- FormRead
  2312. '
  2313. '  INPUTS  -- Template$      Display formvoke shell with
  2314. '             FilName$       Data file to get values from
  2315. '             FixedLength    Whether file is fixed length
  2316. '             DataVar       # bytes data if fixed length; # fields
  2317. '                              if variable length
  2318. '             OverStrike     Whether typeover into form or insert
  2319. '             RecPause      Whether pause after every record displayed
  2320. '                               otherwise when screen fills
  2321. '  OUTPUTS -- (displays data base records)
  2322. '
  2323. '  PURPOSE -- Allows field oriented data base data to be displayed
  2324. '               in a human readable format by substituting field
  2325. '               data into template or form
  2326. '
  2327.       SUB FormRead (Template$,FilName$,FixedLength,DataVar,OverStrike,RecPause) STATIC
  2328. 63422 IF EOF(2) OR ZNo OR (ZErrCode > 0) OR (ZSubParm < 0) THEN _
  2329.          Template$ = "" : _
  2330.          EXIT SUB
  2331.       IF FixedLength THEN _
  2332.          CALL ReadDir (2,1) : _
  2333.          ZGSRAra$(1) = ZOutTxt$ _
  2334.       ELSE CALL ReadParms (ZGSRAra$(),DataVar,1)
  2335.       WasX$ = Template$
  2336.       CALL SmartText (WasX$,ZTrue,OverStrike)
  2337.       CALL MetaGSR (WasX$,OverStrike)
  2338.       CALL BufAsUnit (WasX$)
  2339.       IF RecPause OR (ZPageLength > 0 AND (ZLinesPrinted >= ZPageLength-1)) THEN _
  2340.          CALL PauseExit : _
  2341.          EXIT SUB
  2342.       GOTO 63422
  2343.       END SUB
  2344. 63440 ' $SUBTITLE: 'BufAsUnit - prints string with no pauses'
  2345. ' $PAGE
  2346. '
  2347. '  NAME    -- BufAsUnit
  2348. '
  2349. '  INPUTS  -- Strng$     String to print
  2350. '
  2351. '  OUTPUTS -- none
  2352. '
  2353. '  PURPOSE -- Prints string with embedded carriage returns.
  2354. '             Will never pause.  Used to print when can't call TGet
  2355. '
  2356.       SUB BufAsUnit (Strng$) STATIC
  2357.       WasL = LEN(Strng$)
  2358.       IF WasL < 1 THEN _
  2359.          EXIT SUB
  2360.       StartByte = 1
  2361. 63450 CRat = INSTR(StartByte,Strng$,ZCarriageReturn$)
  2362.       IF CRat > 0 AND CRat < WasL THEN _
  2363.          CRFound = (MID$(Strng$,CRat + 1,1) = ZLineFeed$) _
  2364.       ELSE CRFound = ZFalse
  2365.       EOLlen = -2 * CRFound
  2366.       IF CRFound THEN _
  2367.          EOD = CRat _
  2368.       ELSE EOD = WasL + 1
  2369.       NumBytes = EOD - StartByte
  2370.       ZOutTxt$ = MID$(Strng$,StartByte,NumBytes)
  2371.       ZSubParm = 4
  2372.       CALL TPut
  2373.       CALL SkipLine (-(CRFound))
  2374.       IF ZRet THEN _
  2375.          EXIT SUB
  2376.       StartByte = EOD + EOLlen
  2377.       IF StartByte <= WasL THEN _
  2378.          GOTO 63450
  2379.       END SUB
  2380. 63460 ' Check if macro exists and execute if does
  2381.       SUB MacroExe (Strng$) STATIC
  2382.       CALL Trim (Strng$)
  2383.       CALL Macro (Strng$,Found)
  2384.       IF NOT Found THEN _
  2385.          EXIT SUB
  2386.       CALL FdMacExe
  2387.       END SUB
  2388. 63462 ' Unconditionally executes a macro
  2389.       SUB FdMaCExe STATIC
  2390.       ZOutTxt$ = ""
  2391.       ZMacroEcho = ZFalse
  2392.       ZSubParm = 1
  2393.       CALL TGet
  2394.       END SUB
  2395. 63465 ' Forces a keyboard pause inside a macro
  2396.       SUB PauseExit STATIC
  2397.       ZSubParm = 4
  2398.       ZTurboKey = -ZTurboKeyUser
  2399.       ZOutTxt$ = ZMorePrompt$ + ">" + MID$("? ! ",2*ZTurboKey+1,2)
  2400.       ZForceKeyboard = ZTrue
  2401.       ZNoAdvance = ZTrue
  2402.       CALL TPut
  2403.       ZLinesPrinted = 0
  2404.       ZUserIn$ = ""
  2405.       END SUB
  2406. 63470 ' $SUBTITLE: 'SetPrompt - sub to set prompts based on user security'
  2407. ' $PAGE
  2408. '
  2409. '  NAME    -- SetPrompt
  2410. '
  2411. '  INPUTS  -- PARAMETER           MEANING
  2412. '             ZBegMain          POSITION START OF MAIN CMDS
  2413. '             ZBegFile          POSITION START OF FILE CMDS
  2414. '             ZBegUtil          POSITION START OF UTIL CMDS
  2415. '             ZBegLibrary       POSITION START OF Library CMDS
  2416. '
  2417. '  OUTPUTS -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2418. '             CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2419. '             ZMainOpts$            MAIN OPTS USER CAN DO
  2420. '             ZFileOpts$            FILE OPTS USER CAN DO
  2421. '             ZUtilOpts$            UTIL OPTS USER CAN DO
  2422. '             ZLibOpts$         Library OPTS USER CAN DO
  2423. '
  2424. '  PURPOSE -- Sets command line display of what user can do by
  2425. '             section and display of what all user can do
  2426. '
  2427.       SUB SetPrompt STATIC
  2428.       First = ZBegMain
  2429.       Last = ZBegFile - 1
  2430.       CALL SetOpts (ZMainOpts$,ZInvalidMainOpts$,First,Last)
  2431.       First = ZBegFile
  2432.       Last = ZBegUtil - 1
  2433.       CALL SetOpts (ZFileOpts$,ZInvalidFileOpts$,First,Last)
  2434.       First = ZBegUtil
  2435.       Last = ZBegLibrary - 1
  2436.       CALL SetOpts (ZUtilOpts$,ZInvalidUtilOpts$,First,Last)
  2437.       First = ZBegLibrary
  2438.       Last = ZBegLibrary + 6
  2439.       CALL SetOpts (ZLibOpts$,ZInvalidLibraryOpts$,First,Last)
  2440.       First = 50
  2441.       Last = 56
  2442.       CALL SetOpts (SysOpt$,ZInvalidSysOpts$,First,Last)
  2443.       First = 46
  2444.       Last = 49
  2445.       CALL SetOpts (GlobalOpts$,InvalidGlobalOpts$,First,Last)
  2446.       IF LEN(SysOpt$) > 0 THEN _
  2447.          ZSystemOpts$ = "Sysop: " + _
  2448.                         SysOpt$
  2449.       ZMainOpts$ = GlobalOpts$ + _
  2450.                    ZMainOpts$
  2451.       ZFileOpts$ = GlobalOpts$ + _
  2452.                    ZFileOpts$
  2453.       ZUtilOpts$ = GlobalOpts$ + _
  2454.                    ZUtilOpts$
  2455.       ZLibOpts$ = GlobalOpts$ + _
  2456.                       ZLibOpts$
  2457.       CALL SortString (SysOpt$)
  2458.       CALL SortString (ZMainOpts$)
  2459.       ZMainOpts$ = ZMainOpts$ + _
  2460.                    SysOpt$
  2461.       CALL SortString (ZFileOpts$)
  2462.       CALL SortString (ZUtilOpts$)
  2463.       CALL SortString (ZLibOpts$)
  2464.       CALL AddCommas (ZMainOpts$)
  2465.       CALL AddCommas (ZFileOpts$)
  2466.       CALL AddCommas (ZUtilOpts$)
  2467.       CALL AddCommas (ZLibOpts$)
  2468.       ZDirPrompt$ = "What directory(s) (" + _
  2469.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (ZUserSecLevel => ZMinSecToView) + 9)
  2470.       ZQuitPromptExpert$ = "QUIT C,S, or to F,[M],U,@"
  2471.       ZQuitPromptNovice$ = "QUIT C)onference, S)ession or to section " + _
  2472.                             "F)ile, [M]ain, U)til or @)Library"
  2473.       ZQuitList$ = "FMUS@C"
  2474.       IF ZUserSecLevel < ZOptSec(18) THEN _
  2475.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,23) : _
  2476.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,61) : _
  2477.          MID$(ZQuitList$,5) = " "
  2478.       IF ZUserSecLevel < ZOptSec(15) THEN _
  2479.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,22) + _
  2480.                                MID$(ZQuitPromptExpert$,25) : _
  2481.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,56) + _
  2482.                                MID$(ZQuitPromptNovice$,63) : _
  2483.          MID$(ZQuitList$,3,1) = " "
  2484.       IF ZUserSecLevel < ZOptSec(6) THEN _
  2485.          ZQuitPromptExpert$ = LEFT$(ZQuitPromptExpert$,16) + _
  2486.                                MID$(ZQuitPromptExpert$,19) : _
  2487.          ZQuitPromptNovice$ = LEFT$(ZQuitPromptNovice$,41) + _
  2488.                                MID$(ZQuitPromptNovice$,49) : _
  2489.          MID$(ZQuitList$,1,1) = " "
  2490.       CALL SetSection
  2491.       END SUB
  2492. 63480 ' $SUBTITLE: 'NoPath - detects whether string has path'
  2493. ' $PAGE
  2494. '
  2495. '  NAME    -- NoPath
  2496. '
  2497. '  INPUTS  -- Strng$     String to check
  2498. '
  2499. '  OUTPUTS -- HAS.NONE   True if has no path
  2500. '
  2501. '  PURPOSE -- Detects whether have path.  Used when shouldn't
  2502. '             be any
  2503. '
  2504.       SUB NoPath (Strng$,HasPath) STATIC
  2505.       CALL BreakFileName (Strng$,DrvPath$,Prefix$,Ext$,ZFalse)
  2506.       HasPath = (DrvPath$ <> "")
  2507.       END SUB
  2508. 63490 ' $SUBTITLE: 'FindIt - Determine whether file exists'
  2509. ' $PAGE
  2510. '
  2511. '  NAME    -- FindIt
  2512. '
  2513. '  INPUTS  -- FilName$   File name to check
  2514. '
  2515. '  OUTPUTS -- ZOK         True if file exists.  Opened as #2 if does
  2516. '
  2517. '  PURPOSE -- Determine whether file exists and open as standard work
  2518. '             file if it does (#2)
  2519. '
  2520.       SUB FindIt (FilName$) STATIC
  2521.       CALL FindItX (FilName$,2)
  2522.       END SUB
  2523. 63495 ' $SUBTITLE: 'TimeBack - Give time back to the user'
  2524. ' $PAGE
  2525. '
  2526. '  NAME    -- TimeBack
  2527. '
  2528. '  INPUTS  -- Index    = 1    Set start of time (begin give back)
  2529. '                      = 2    Give back time from defined start
  2530. '
  2531. '  OUTPUTS -- ZTimeCredits!         Number of seconds to credit with
  2532. '             ZSecsPerSession!  Number of seconds in current session
  2533. '
  2534. '  PURPOSE -- Give time back to the user (e.g. sysop initiated chat)
  2535. '
  2536.       SUB TimeBack (Index) STATIC
  2537.       IF Index = 1 THEN _
  2538.          CALL TimeRemain (MinsRemaining) : _
  2539.          ZWasQ! = ZSecsUsedSession! : _
  2540.          EXIT SUB
  2541.       CALL TimeRemain (MinsRemaining)
  2542.       WasX! = (ZSecsUsedSession! - ZWasQ!)
  2543.       ZTimeCredits! = ZTimeCredits! + WasX!
  2544.       END SUB
  2545. 63500 ' $SUBTITLE: 'CmdStackPushPop - Save/restore command stack'
  2546. ' $PAGE
  2547. '
  2548. '  NAME    -- CmdStackPushPop
  2549. '
  2550. '  INPUTS  -- Index    = 1    Save command stack
  2551. '                      = 2    Restore command stack
  2552. '             ZAnsIndex
  2553. '             ZLastIndex
  2554. '             ZUserIn$()
  2555. '
  2556. '  OUTPUTS -- ZUserIn$()                  Stacked commands
  2557. '             ZAnsIndex
  2558. '             ZLastIndex
  2559. '
  2560. '  PURPOSE -- Save restore a command stack list when need to input
  2561. '             another list in middle of previous list processing
  2562. '
  2563.       SUB CmdStackPushPop (Index) STATIC
  2564.       IF Index = 1 THEN _
  2565.          OrigLastIndex = ZLastIndex : _  ' save
  2566.          OrigIndex = ZAnsIndex : _
  2567.          FOR WasI = 1 TO OrigLastIndex : _
  2568.              ZOutTxt$(WasI) = ZUserIn$(WasI) : _
  2569.          NEXT : _
  2570.          EXIT SUB
  2571.       ZLastIndex = OrigLastIndex        ' restore
  2572.       ZAnsIndex = OrigIndex
  2573.       FOR WasI = 1 TO OrigLastIndex
  2574.          ZUserIn$(WasI) = ZOutTxt$(WasI)
  2575.       NEXT
  2576.       END SUB
  2577. 63510 ' $SUBTITLE: 'VerifyAns - edits an answer'
  2578. ' $PAGE
  2579. '
  2580. '  NAME    -- VerifyAns
  2581. '                                  MEANING
  2582. '  INPUTS  -- ZVerifying      Whether verifying
  2583. '             ZUserIn$(1)     Response verifying
  2584. '             ZVerifyList$    List of appropriate answers.  1st
  2585. '                                char is what separates answers
  2586. '             ZVerifyNumeric     Verify that is a valid integer
  2587. '                                  if false, then verifying that
  2588. '                                  a string is between 2 values
  2589. '             ZVerifyLow$     Lowest ok value of string
  2590. '             ZVerifyHigh$    Highest ok value of string
  2591. '
  2592. '  OUTPUTS -- ZOK             Whether passes verification
  2593. '             ZVerifyList$    Empties if ok
  2594. '             ZVerifying      Sets false if ok
  2595. '             ZVerifyNumeric  Sets false if ok
  2596. '
  2597. '  PURPOSE -- Processes edits on a user input
  2598. '
  2599.       SUB VerifyAns STATIC
  2600.       ZOK = ZTrue
  2601.       IF NOT ZVerifying THEN _
  2602.          EXIT SUB
  2603.       Temp$ = ZUserIn$(1)
  2604.       CALL AllCaps (Temp$)
  2605.       IF ZVerifyList$ <> "" THEN _
  2606.          WasX$ = LEFT$(ZVerifyList$,1) : _
  2607.          ZOK = (INSTR (ZVerifyList$, WasX$+Temp$+WasX$) > 0) _
  2608.       ELSE IF ZVerifyNumeric THEN _
  2609.               CALL CheckInt (ZUserIn$) : _
  2610.               ZOK = (ZErrCode = 0 AND _
  2611.                     ZTestedIntValue >= VAL(ZVerifyLow$) AND _
  2612.                     ZTestedIntValue <= VAL(ZVerifyHigh$)) _
  2613.            ELSE ZOK = (Temp$ >= ZVerifyLow$ AND Temp$ <= ZVerifyHigh$)
  2614.       IF ZOK THEN _
  2615.          ZVerifyList$ = "" : _
  2616.          ZVerifying = ZFalse : _
  2617.          ZVerifyNumeric = ZFalse
  2618.       END SUB
  2619. 63520 ' $SUBTITLE: 'BinSearch - binary search a file'
  2620. ' $PAGE
  2621. '
  2622. '  NAME    -- BinSearch
  2623. '                                  MEANING
  2624. '  INPUTS  -- PassedSearchFor$  Value you are looking for
  2625. '             StartPos          Starting position of sort key
  2626. '             NumChars          # of characters in sort key
  2627. '             LenRec            Length of record of data file searching
  2628. '             High              Record # of last record
  2629. '             ZFastTabs$        In a binary integer subfield (2 bytes)
  2630. '                                  holds 1st record when might find
  2631. '                                  a key beginning with a particular
  2632. '                                  character (0-9,A-Z).   Empty if
  2633. '                                  no Fast Tab exists for the file.
  2634. '
  2635. '  OUTPUTS -- RecFoundAt        Record # value found at (0 if none)
  2636. '             RecFound$         Full data record when found
  2637. '
  2638. '  PURPOSE -- Binary searches work file #2 for a key value in a
  2639. '             data file that is sorted on a key field
  2640. '
  2641.       SUB BinSearch (PassedSearchFor$,StartPos, NumChars, LenRec, High, RecFoundAt, RecFound$) STATIC
  2642.       SearchFor$ = LEFT$(PassedSearchFor$,NumChars)
  2643.       SearchFor$ = SearchFor$ + SPACE$(NumChars-LEN(SearchFor$))
  2644.       FIELD #2, LenRec AS SearchRec$
  2645.       Low = 0
  2646.       IF LEN(ZFastTabs$) < 72 THEN _
  2647.          GOTO 63522
  2648.       WasX$ = LEFT$(SearchFor$,1)
  2649.       WasX = INSTR("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",WasX$)
  2650.       IF WasX > 0 THEN _
  2651.          Low = CVI(MID$(ZFastTabs$,1+2*(WasX-1),2)) - 1
  2652.       IF WasX < 36 THEN _
  2653.          High = CVI(MID$(ZFastTabs$,1+2*WasX,2))
  2654. 63522 RecFoundAt = 0
  2655.       IF High < 1 THEN _                                             ' KG072102
  2656.          EXIT SUB                                                    ' KG072102
  2657.       WasX$ = SPACE$ (NumChars)
  2658.       Done = ZFalse
  2659.       WHILE NOT Done
  2660.          WasI = INT(((High + Low) / 2) + .5)
  2661.          GET 2, WasI
  2662.          LSET WasX$ = MID$(SearchRec$, StartPos, NumChars)
  2663.          IF WasX$ = SearchFor$ THEN _
  2664.             RecFound$ = SearchRec$: _
  2665.             RecFoundAt = WasI : _
  2666.             Done = ZTrue _
  2667.          ELSE IF (High - Low) < 2 THEN _
  2668.                  Done = ZTrue _
  2669.               ELSE IF WasX$ < SearchFor$ THEN _
  2670.                       Low = WasI _
  2671.                    ELSE IF WasX$ > SearchFor$ THEN _
  2672.                            High = WasI
  2673.       WEND
  2674.       END SUB
  2675. 63530 ' Take modem offhook
  2676.       SUB TakeOffHook STATIC
  2677.       CALL ModemPut (ZModemGoOffHookCmd$)
  2678.       CALL DelayTime (3)
  2679.       END SUB
  2680. 63540 ' Match Name to one in message file
  2681.       SUB MsgNameMatch (PrimeName$,AltName$,SearchPos,Found) STATIC
  2682.       WasX$ = LEFT$(PrimeName$+"  ",22-8*(SearchPos < 7))
  2683.       GOSUB 63542                                                    ' KG052201
  2684.       IF Found OR AltName$ = "" THEN _                               ' KG052201
  2685.          EXIT SUB                                                    ' KG052201
  2686.       WasX$ = LEFT$(AltName$ + "  ",22-8*(SearchPos < 7))
  2687.       GOSUB 63542                                                    ' KG052201
  2688.       EXIT SUB                                                       ' KG052201
  2689. 63542 WasY$ = MID$(ZMsgRec$,SearchPos,LEN(WasX$))                    ' KG052201
  2690.       ZWasDF = INSTR(WasY$,"@")                                      ' KG052201
  2691.       IF ZWasDF > 0 THEN _                                           ' KG052201
  2692.          MID$(WasY$,ZWasDF) = "      "                               ' KG052201
  2693.       Found = (WasY$ = WasX$)                                        ' KG052201
  2694.       RETURN                                                         ' KG052201
  2695.       END SUB
  2696.